Mar 10 2023 01:36 AM
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
3. But whenever J is changed, it changes the time in A which is INCORRECT
How can I modify the VBA code to still do 1. and 2., but keep the first record without changing if J is changed (not deleted)?
Thank you in advance.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
Application.EnableEvents = False
If .Column = Range("j:j").Column Then
If ActiveCell <> "" Then
Cells(.Row, "a").Value = Format(Now, "dd/mm/yyyy hh:mm")
Else: Cells(.Row, "a").Value = ""
End If
End If
End With
Next Cell
Application.EnableEvents = True
End Sub
Mar 10 2023 03:39 AM
SolutionThe 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
Mar 10 2023 03:52 AM
Mar 10 2023 03:56 AM
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
Mar 10 2023 04:00 AM
Mar 10 2023 03:39 AM
SolutionThe 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