Add more than 1 timestamp on one Excel Worksheet-CodePudding

i have some issue...

I have work sheet in order to track CRM pipeline activities. and Every status changed will be recorded by a time stamp... but, i dont know how to make more than one time stamp...

Here the condition:

Cell "A" will be as Range and Trigger, Then Cell "B" will be as target timestamp I.

Cell "G" will be as Range and Trigger, Then Cell "H" will be as target timestamp II.

Cell "P" will be as Range and Trigger, Then Cell "Q" will be as target timestamp III.

Cell "AA" will be as Range and Trigger, Then Cell "AB" will be as target timestamp IV.

The Range and Trigger Values can be as number and/or text.

This my Worksheet Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myTableRange1 As Range
Dim myTrigger1 As Range
Dim myUpdatedRange1 As Range

'Your data table range
Set myTableRange1 = Range("B6:B50000")

'Check if the changed cell is in the data tabe or not.
If Intersect(Target, myTableRange1) Is Nothing Then Exit Sub

'Stop events from running
Application.EnableEvents = False

'Column for the date/time
Set myTrigger1 = Range("B" & Target.Row)

'Column for last updated date/time
Set myUpdatedRange1 = Range("G" & Target.Row)

'Determine if the input date/time should change
If myTrigger1.Value = "" Then

myUpdatedRange1.Value = Now   

End If

'Update the updated date/time value
myUpdatedRange1.Value = Now

'Turn events back on
Application.EnableEvents = True
End Sub

CodePudding user response：

A Worksheet Change: Multiple Timestamp Columns

This will add a timestamp only if the 'timestamp cell' is blank.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const FirstRow As Long = 6
    Const ColumnsRangeAddress As String = "A:A,G:G,P:P,AA:AA"
    
    Dim srg As Range: Set srg = Intersect(Rows(FirstRow) _
        .Resize(Rows.Count - FirstRow   1), Range(ColumnsRangeAddress))
    
    Dim irg As Range: Set irg = Intersect(srg, Target)
    If irg Is Nothing Then Exit Sub
    
    Dim drg As Range
    Dim iCell As Range
    
    For Each iCell In irg.Cells ' 'A,G,P,AA'
        With iCell.Offset(, 1) ' 'B,H,Q,AB'
            If Len(CStr(.Value)) = 0 Then ' is blank
                If drg Is Nothing Then
                    Set drg = .Cells
                Else
                    Set drg = Union(drg, .Cells)
                End If
            'Else ' is not blank; do nothing
            End If
        End With
    Next iCell
    
    If drg Is Nothing Then Exit Sub
    
    Application.EnableEvents = False ' before writing
    drg.Value = Now
    Application.EnableEvents = True ' after writing

End Sub