Automatic VBA Time Stamp when Copying and pasting-CodePudding

Im new to VBA and was wondering if anyone can help me.

i have created this code which automatically adds a timestamp to a specific row when a cell is edited. However, if i want to paste in a load of data into the sheet, only the first row gets the timestamp, instead of every row.

can anyone help me?

thank you

Below is the current code used;

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MyTableRange As Range
Dim myUpdatedRange As Range

Set MyTableRange = Range("A2:J150")

If Intersect(Target, MyTableRange) Is Nothing Then Exit Sub

Set myUpdatedRange = Range("K" & Target.Row)

myUpdatedRange.Value = Now()

End Sub

CodePudding user response：

Target contains all cells that where modified. Simply loop over all cells in target will give you every single cell that was modified:

Dim cell As Range
For Each cell In Target
   ...
Next

As you want to put only one timestamp per row, you can limit the loop to all cells of the first column of Target:

Dim cell As Range
For Each cell In Target.Columns(1).Cells
    Cells(cell.Row, "K") = Now
    ' or, if you prefer:
    ' Range("K" & cell.Row) = Now
Next

CodePudding user response：

A Worksheet Change: A Simple Time Stamp

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ClearError
    
    Dim srg As Range: Set srg = Range("A2:J150")
    
    Dim irg As Range: Set irg = Intersect(srg, Target)
    If irg Is Nothing Then Exit Sub
    
    Dim drg As Range: Set drg = Intersect(irg.EntireRow, Columns("K"))
    
    Application.EnableEvents = False

    drg.Value = Now
 
SafeExit:
    If Not Application.EnableEvents Then Application.EnableEvents = True
    
    Exit Sub
ClearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit
End Sub