CODEWITHSUNDEEP
excelvbaexcel-formula
Adam Mann Pro
Adam Mann Pro

Reputation: 265

Update excel cell with date if a cell in a range is update

I need to update a cell with the date and time stamp (NOW()) if any cell is updated within any cell before it within that same row.

So update cell "CU" with date and time when any cell from "A-CR" is updated.

I have done some searching but I can only seem to find bits that work if only updating a single cell, I'm looking for if anything changes within that range.

I currently have some Vba which does something similar which will update the adjacent cell with time and date which is required but I also need an overall one for the whole 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

safe_exit: Application.EnableEvents = True Application.ScreenUpdating = True End Sub

Upvotes: 0

Views: 903

Answers (2)

Rinshad
Rinshad

Reputation: 131

The below code takes care of:

  1. Clearing the time if the row is blank.
  2. Updating the time only if the values really change 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

Upvotes: 0

Damian
Damian

Reputation: 5174

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

Upvotes: 0

Related Questions