SOLVED

Modify VBA code in Excel from dynamic date and time to static

Copper Contributor

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

4 Replies
best response confirmed by Estel333 (Copper Contributor)
Solution

@Estel333 

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
Thank 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.

@Estel333 

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
Perfect. Thank you so much. Your assistance is deeply appreciated.
1 best response

Accepted Solutions
best response confirmed by Estel333 (Copper Contributor)
Solution

@Estel333 

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

View solution in original post