Lock cells in worksheet after they are changed
I have two different audit trail macros: The fist one that has a pop-up for for data entry reason after every entry and the second has a pop-up only when saving the workbook. What I have been trying to do is to add a lock cells to the macro for any new data. Any cells that require data entry are already unlocked and there are cells with formulas that are unlocked. I do not want to lock these unless something new is entered. The code for the pop-up for every entry is as follows:
[CODE]
Dim PreviousValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long
Dim UserInput
Application.EnableEvents = False
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub
With Sheets("Audit Trail")
.Unprotect Password:="xyz"
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Target.Address(False, False)
.Range("B" & NR).Value = ActiveSheet.Name
.Range("C" & NR).Value = Now
.Range("D" & NR).Value = Environ("username")
.Range("E" & NR).Value = PreviousValue
.Range("F" & NR).Value = Target.Value
strReply = Application.InputBox("Please enter a data entry reason.", "Data Entry Reason", _
Default:="New data", Type:=2)
If strReply = "False" Or strReply = "" Then strReply = "New data"
.Range("G" & NR).Value = strReply
' If .Range("G" & NR).Value = "" Then
' Range("G" & NR).Value = ""
' MsgBox "You MUST provide a data entry reason.", vbCritical, "No Reason Given"
' End If
Application.EnableEvents = True
.Protect Password:="xyz"
End With
End Sub
[/CODE]
There is two codes for the pop-up when saving, a worksheet code and a workbook code. The worksheet code is as follows:
[CODE]
Dim PreviousValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR As Long
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With Sheets("Audit Trail")
.Unprotect Password:="xyz"
NR = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Target.Address(False, False)
.Range("B" & NR).Value = ActiveSheet.Name
.Range("C" & NR).Value = Now
.Range("D" & NR).Value = Environ("username")
.Range("E" & NR).Value = PreviousValue
.Range("F" & NR).Value = Target.Value
.Protect Password:="xyz"
End With
Application.EnableEvents = True
End Sub
[/CODE]
With the workbook code:
[CODE]
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim LastRowA As Long
Dim LastRowG As Long
Dim Reason As String
With Sheets("Audit Trail")
LastRowA = .Range("A" & Rows.Count).End(xlUp).Row
LastRowG = .Range("G" & Rows.Count).End(xlUp).Row
End With
If LastRowA <> LastRowG Then
Do
Reason = InputBox("Please enter a data entry reason.", "Data Entry Reason", "New data")
If Reason = "" Then
msg = MsgBox("You MUST provide a data entry reason.", vbCritical, "No Reason Given")
End If
Loop Until Reason <> ""
With Sheets("Audit Trail")
.Unprotect Password:="xyz"
.Range("G" & LastRowG + 1 & ":G" & LastRowA) = Reason
.Protect Password:="xyz"
End With
End If
End Sub
[/CODE]
I tried adding the following code with both worksheet codes, but couldn't get it to work:
[CODE]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim PW As String
PW = "xyz"
If Intersect(Target, Range("A1:DW400")) Is Nothing Then Exit Sub
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
If Target.Value = PreviousValue Then Exit Sub
Target.Worksheet.Unprotect PW
Target.Value ("A1:DW400").Locked = True
Target.Worksheet.Protect PW
End With
Application.EnableEvents = True
End Sub
[/CODE]
Does anybody know what I'm doing wrong? I tried to attach the files and links for the workbooks that have pop-ups after save and pop-ups after each entry with 2 worksheets in each - some of my workbooks could have as many as 36 worksheets, but it didn't work. Links that can be copies into your browser are below. Whichever audit trail is the one that ends up being used, I would rather have the cells locked at save, rather than after each entry. That way if the data entry person sees their mistake before saving, they can make the correction without needing a password. the audit trail will still capture the change, but the sheet will not have to be unlocked.
https://skydrive.live.com/view.aspx?cid=E64C264EBE8F1355&resid=E64C264EB...
https://skydrive.live.com/view.aspx?cid=E64C264EBE8F1355&resid=E64C264EB...
Recent comments
5 years 41 weeks ago
6 years 27 weeks ago
6 years 39 weeks ago
6 years 42 weeks ago
6 years 43 weeks ago
6 years 48 weeks ago
7 years 4 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago