Modifying Excel’s Date Based on Cell Alteration

Feedback


Question:

In case any cell within a row is updated before any cell that comes after it, I require a date and time stamp (NOW()) to be added to that particular cell.

Trigger a “CU” event along with the date and time whenever a cell in the range “A-CR” is modified.

Although I have conducted some research, I have only come across fragments that are applicable when updating just one cell. However, I am in search of a solution that covers any changes made within that range.

I currently have a VBA code that updates
adjacent cell
with the required time and date. However, I also need a comprehensive one for the entire process.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, AE:AE, AH:AH, AK:AK, AN:AN, AQ:AQ, AT:AT, AW:AW, AZ:AZ, BC:BC, BF:BF, BI:BI, BL:BL, BO:BO, BR:BR, BU:BU, BX:BX, CA:CA, CD:CD, CG:CG, CJ:CJ, CM:CM, CP:CP")) Is Nothing Then
    On Error GoTo safe_exit
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        Dim trgt As Range, ws1 As Worksheet
        'Set ws1 = ThisWorkbook.Worksheets("Info")
        For Each trgt In Intersect(Target, Range("F:F, I:I, L:L, O:O, R:R, U:U, X:X, AA:AA, AB:AB, AE:AE, AH:AH, AK:AK, AN:AN, AQ:AQ, AT:AT, AW:AW, AZ:AZ, BC:BC, BF:BF, BI:BI, BL:BL, BO:BO, BR:BR, BU:BU, BX:BX, CA:CA, CD:CD, CG:CG, CJ:CJ, CM:CM, CP:CP"))
            If trgt <> vbNullString Then
                If UCase(trgt.Value) = "Y" Or UCase(trgt.Value) = "N" Then
                    Cells(trgt.Row, trgt.Column + 1) = Now()
                    Cells(trgt.Row, trgt.Column + 2) = Environ("username")
                    'Select Case trgt.Column
                    '    Case 2   'column B
                    '        Cells(trgt.Row, trgt.Column + 1) = Environ("username")
                    '     Case 4   'column D
                    '       'do something else
                    ' End Select
                Else
                    trgt = ""
                    Cells(trgt.Row, trgt.Column + 1) = ""
                    Cells(trgt.Row, trgt.Column + 2) = ""
                End If
            End If
        Next trgt
        'Set ws1 = Nothing
    End With
End If

The code block labeled “safe_exit” consists of two lines of code that reactivate Excel events and screen updating, respectively.


Solution 1:

This works for me:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Intersect(Target, Me.Range("A" & Target.Row & ":CR" & Target.Row)) Is Nothing Then GoTo SafeExit
    Me.Cells(Target.Row, "CU") = Now()
SafeExit:
    Application.EnableEvents = True
End Sub


Solution 2:

The below code takes care of:

  1. Removing the duration if the line is empty.
  2. The time will be updated solely in the event that there is an actual difference from the previous value.
Dim oldValue As String
'Change the range below where your data will be
Const RangeString = "A:CR"
'Below variable decides the column in which date will be displayed
'Change the below value to 1 for column A, 2 for B, ... 99 for CU
Const ColumnIndex = 99
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WorkRng As Range
    Dim HorizontalRng As Range
    Dim Rng As Range
    Dim HorRng As Range
    Dim RowHasVal As Boolean
    Set WorkRng = Intersect(ActiveSheet.Range(RangeString), Target)
    If Not WorkRng Is Nothing Then
        If WorkRng.Cells.Count = 1 And WorkRng.Cells(1, 1).Value = oldValue Then
            Exit Sub
        End If
        Application.EnableEvents = False
        For Each Rng In WorkRng
            Set HorizontalRng = Intersect(ActiveSheet.Range(RangeString), Rows(Rng.Row))
            RowHasVal = False
            For Each HorRng In HorizontalRng
                If Not VBA.IsEmpty(HorRng.Value) Then
                    RowHasVal = True
                    Exit For
                End If
            Next
            If Not RowHasVal Then
                ActiveSheet.Cells(Rng.Row, ColumnIndex).ClearContents
            ElseIf Not VBA.IsEmpty(Rng.Value) Then
                ActiveSheet.Cells(Rng.Row, ColumnIndex).Value = Now
                ActiveSheet.Cells(Rng.Row, ColumnIndex).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, ActiveSheet.Range(RangeString)) Is Nothing Then
        If Target.Cells.Count = 1 Then
            oldValue = Target.Value
        Else
            oldValue = ""
        End If
    End If
End Sub

Frequently Asked Questions