Forum Discussion
Estel333
Mar 10, 2023Copper Contributor
Modify VBA code in Excel from dynamic date and time to static
Hi, 1. I am using this VBA code to record dd/mm/yyyy hh:mm in column A whenever a selection is made in column J. 2. Whenever column J is deleted, column A is also deleted which is CORRECT ...
- Mar 10, 2023
The following will work if the user edits one cell at a time:
Private Sub Worksheet_Change(ByVal Target As Range) Dim NewVal As Variant If Target.CountLarge > 1 Then Exit Sub If Not Intersect(Range("J:J"), Target) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False If Target.Value = "" Then Range("A" & Target.Row).ClearContents Else NewVal = Target.Value Application.Undo If Target.Value = "" Then Range("A" & Target.Row).Value = Now End If Target.Value = NewVal End If Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub
HansVogelaar
Mar 10, 2023MVP
The following will work if the user edits one cell at a time:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewVal As Variant
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Range("J:J"), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Value = "" Then
Range("A" & Target.Row).ClearContents
Else
NewVal = Target.Value
Application.Undo
If Target.Value = "" Then
Range("A" & Target.Row).Value = Now
End If
Target.Value = NewVal
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
- Estel333Mar 10, 2023Copper ContributorThank you so much! It works.
May I ask how it can be modified if there are two sets on the same page?
1. On another sheet when B is completed, the static date and time must be recorded in F
2. And on the same sheet, when O is completed, the static date and time must be recorded in G
Once again thank you for your expert response.- HansVogelaarMar 10, 2023MVP
Like this:
Private Sub Worksheet_Change(ByVal Target As Range) Dim NewVal As Variant If Target.CountLarge > 1 Then Exit Sub If Not Intersect(Range("B:B"), Target) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False If Target.Value = "" Then Range("F" & Target.Row).ClearContents Else NewVal = Target.Value Application.Undo If Target.Value = "" Then Range("F" & Target.Row).Value = Now End If Target.Value = NewVal End If Application.EnableEvents = True Application.ScreenUpdating = True ElseIf Not Intersect(Range("O:O"), Target) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False If Target.Value = "" Then Range("G" & Target.Row).ClearContents Else NewVal = Target.Value Application.Undo If Target.Value = "" Then Range("G" & Target.Row).Value = Now End If Target.Value = NewVal End If Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub
- Estel333Mar 10, 2023Copper ContributorPerfect. Thank you so much. Your assistance is deeply appreciated.