I’d like to time stamp and add application username multiple different ranges on the same worksheet when any changes are made to rows in each range

Question

Example of one of my tables I used this event macro for a single Table, but I would like to see if there is a way to use a similar macro but it applies to all tables. For example, if I make a change in table1 (V3:AG34) I would like column AH to have a username/timestamp in each row that has a change within that table. If I make a change to Table5 (BP3:BU160) I would like column BV to have a username/timestamp in each row that has a change in within that table. Is this possible, and can be written to update if I add rows to those tables? Some of the tables in the worksheet are being populated using Xlookup.

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim r As Range, Intersection As Range, cell As Range
        Dim s As String
    
        Set r = Range("B3:CA1003")
        Set Intersection = Intersect(r, Target)
        s = vbCrLf & Environ("USERNAME") & vbCrLf & Application.UserName
    
        If Intersection Is Nothing Then Exit Sub
    
        Application.EnableEvents = False
            For Each cell In Intersection
                Range("A" & cell.Row).Value = Date & " " & Time & s
            Next cell
        Application.EnableEvents = True
    End Sub

Any help would be greatly appreciated.

Thanks in advance!

I’ve searched the internet for any sort of semblance of an answer to this and I’ve not been able to convert this to multiple ranges on the same worksheet.

Answer 1

A Worksheet Change: Multiple Excel Tables (ListObjects)

• Note that it is assumed that you have added a 'stamp' column to each table.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lo As ListObject, irg As Range, drg As Range, urg As Range
    
    For Each lo In Me.ListObjects
        With lo.DataBodyRange
            Set irg = Intersect(.Resize(, .Columns.Count - 1), Target)
            If Not irg Is Nothing Then
                Set drg = Intersect(irg.EntireRow, .Columns(.Columns.Count))
                If urg Is Nothing Then
                    Set urg = drg
                Else
                    Set urg = Union(urg, drg)
                End If
                Set irg = Nothing ' reset for the next iteration
            End If
        End With
    Next lo
                        
    If urg Is Nothing Then Exit Sub
                    
    Dim Stamp As String: Stamp = Now _
        & vbLf & Environ("USERNAME") & vbLf & Application.UserName

    Application.EnableEvents = False
        urg.Value = Stamp
    Application.EnableEvents = True
                    
End Sub

Initial Post

A Worksheet Change: Time Stamp and User

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const FIRST_ROW_RANGE As String = "B3:CA3"
    Const STAMP_COLUMN As String = "A"
    
    Dim trg As Range
    
    With Me.Range(FIRST_ROW_RANGE)
        Set trg = .Resize(Me.Rows.Count - .Row + 1)
    End With
    
    Dim irg As Range: Set irg = Intersect(trg, Target)
    If irg Is Nothing Then Exit Sub
    
    Dim drg As Range
    Set drg = Intersect(irg.EntireRow, Me.Columns(STAMP_COLUMN))
    
    Dim Stamp As String: Stamp = Now _
        & vbCrLf & Environ("USERNAME") & vbCrLf & Application.UserName
    
    Application.EnableEvents = False
        drg.Value = Stamp
    Application.EnableEvents = True

End Sub