Weetniet
Weetniet

Reputation: 25

Track changes by creating timestamp

The original code (Excel VBA) I found works fine for keeping track of one column:

Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("P:P"), Target)
xOffsetColumn = 2
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Date
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
        Next
    Application.EnableEvents = True
End If
End Sub

I want to track two columns. Below, you will find the newly added code. It does not work, even though I changed variable names after the Dim (by adding a b). Simple copy-pasting the old code and then only change the range from P:P to S:S and the xOffsetColumn also does not work.

Private Sub Worksheet_Change_b(ByVal Target As Range)
'Update 20140722
Dim WorkRngb As Range
Dim Rngb As Range
Dim xOffsetColumnb As Integer
Set WorkRngb = Intersect(Application.ActiveSheet.Range("S:S"), Target)
xOffsetColumnb = 3
If Not WorkRngb Is Nothing Then
    Application.EnableEvents = False
    For Each Rngb In WorkRngb
        If Not VBA.IsEmpty(Rngb.Value) Then
            Rngb.Offset(0, xOffsetColumnb).Value = Date
            Rngb.Offset(0, xOffsetColumnb).NumberFormat = "dd-mm-yyyy"
        Else
            Rngb.Offset(0, xOffsetColumnb).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

Upvotes: 2

Views: 718

Answers (1)

user4039065
user4039065

Reputation:

This modification to your original Worksheet_Change event macro should take care of both columns including pasting multiple values into a range that encompasses one or both columns.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Update 20150930
    If Not Intersect(Target, Union(Columns("P"), Columns("S"))) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        Dim rng As Range
        For Each rng In Intersect(Target, Union(Columns("P"), Columns("S")))
            If Not VBA.IsEmpty(rng) Then
                rng.Offset(0, 2 - CBool(rng.Column = 19)) = Date
                rng.Offset(0, 2 - CBool(rng.Column = 19)).NumberFormat = "dd-mm-yyyy"
            Else
                rng.Offset(0, 2 - CBool(rng.Column = 19)).ClearContents
            End If
        Next rng
    End If
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

To simply the offset, I simply worked back two columns from column P to column N. I'm not sure why the second event macro sample only moved back to column P; I didn't think it was your intention to overwrite the values in column P.

The Application.ActiveSheet.Range("P:P") column reference was unnecessary and potentially dangerous if the event macro was triggered by code that changed one of the values while another worksheet held the ActiveSheet property. Worksheet code pages are private by default; module code pages are public by default. You can reference cells and ranges without explicitly declaring their parent in a worksheet code sheet while that is bad coding practice on a module code sheet.

I also changed the value used for the timestamp from Date to Now. The cell formatting will still only display the date but if you ever need it, you will have the time as well.

Upvotes: 2

Related Questions