I am trying to figure out a way in VBA to give a timestamp when a cell is updated, but I want that timestamp to be static and only update one time, the first time.
Columns A-I are a checklist and the user only inputs "X" as the process is being completed. Columns AH-AP are timestamp cells the correspond to the fields above.
A pairs with AH, B pairs with AI, so on and so on.
So if A2 is updated by a user, I need AH2 to have a static timestamp. If B3 is updated by a user, I need AI3 to have a static timestamp.
Currently I have VBA code that locks both the cells that users have entered "X" and the timestamp formula cells so it works but its clunky. Would much rather have a way to make these timestamp formulas into values right away VS going back periodically to change them over.
Below is in a Module, I have this code 9 times over (lockA - lockI) with the appropriate fields changed.
Sub lockA()
Application.ScreenUpdating = False
ActiveSheet.Unprotect
ActiveSheet.Range("$A$1:$AP$1000").AutoFilter Field:=1, Criteria1:="<>"
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Range("$A$1:$AP$1000").AutoFilter Field:=1
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub
Below is in my Worksheet:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
Call lockA
End If
If Not Intersect(Target, Range("B2:B1000")) Is Nothing Then
Call lockB
End If
If Not Intersect(Target, Range("C2:C1000")) Is Nothing Then
Call lockC
End If
If Not Intersect(Target, Range("D2:D1000")) Is Nothing Then
Call lockD
End If
If Not Intersect(Target, Range("E2:E1000")) Is Nothing Then
Call lockE
End If
If Not Intersect(Target, Range("F2:F1000")) Is Nothing Then
Call lockF
End If
If Not Intersect(Target, Range("G2:G1000")) Is Nothing Then
Call lockG
End If
If Not Intersect(Target, Range("H2:H1000")) Is Nothing Then
Call lockH
End If
If Not Intersect(Target, Range("I2:I1000")) Is Nothing Then
Call lockI
End If
End Sub
Updated Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
' change in target columns
If Not Intersect(Target, Range("A2:H1000")) Is Nothing Then
Application.EnableEvents = False
Me.Unprotect Password:="check"
Dim c As Range: Set c = Target.Offset(0, 33) ' timestamp cell
If IsEmpty(c.Value) Then ' If no timestamp in the cell
c.Value = Now ' populate cell with timestamp
c.Locked = True ' lock cell
End If
Target.Locked = True ' lock input cell
Me.Protect Password:="check", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
Application.EnableEvents = True
End If
End Sub
All processing can be handled within the Change
event.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
' change in target columns
If Not Intersect(Target, Range("A2:I1000")) Is Nothing Then
Application.EnableEvents = False
Me.Unprotect
Dim c As Range: Set c = Target.Offset(0, 33) ' timestamp cell
If IsEmpty(c.Value) Then ' no timestamp in the cell
c.Value = Now ' populate cell with timestamp
c.Locked = True ' lock cell
End If
Target.Locked = True ' lock input cell
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.EnableEvents = True
End If
End Sub