Change Log Tracking

[ffionnah]

Hi all.
Thank you, in advance, for your help.

I found this code to track any changes made to each tab. I have a table in columns A-AV (different rows for each tab, depending on the data).

Is there anyway to update this code to not track when rows are inserted?

Additionally, how would I write this to only track columns A to AV ?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LR As Long
Dim c As Range
Application.EnableEvents = False
With Sheets("Log Sheet")
    For Each c In Target
    LR = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    .Cells(LR, "A").Value = Sh.Name & "!" & c.Address
    .Cells(LR, "B").Value = Now
    .Cells(LR, "C").Value = c.Value
    .Cells(LR, "D").Value = Application.UserName
    Next c
End With
Application.EnableEvents = True
End Sub

 

[dmt32]

Hi,
As far as I am aware there is no event to track rows being inserted / deleted so will need a workaround.

Not fully tested but give following update to your code & see if helps you

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Sh.Cells(1, 1).ID = Sh.UsedRange.Rows.Count
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim LR As Long
    Dim c As Range
    With Sh.Cells(1, 1)
'check if rows inserted / deleted
        If Sh.UsedRange.Rows.Count <> Val(.ID) Then .ID = Sh.UsedRange.Rows.Count: GoTo exitsub
    End With
    If Not Intersect(Target, Sh.Range("A:AV")) Is Nothing Then
    Application.EnableEvents = False
    With Sheets("Log Sheet")
    If Sh.Name = .Name Then GoTo exitsub
        For Each c In Target
        LR = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(LR, "A").Value = Sh.Name & "!" & c.Address
        .Cells(LR, "B").Value = Now
        .Cells(LR, "C").Value = c.Value
        .Cells(LR, "D").Value = Application.UserName
        Next c
    End With
    End If
exitsub:
Application.EnableEvents = True
End Sub

When you select a sheet, the ID property of Range A1 is used as a place holder for the usedrange rows count. This is checked in the sheetchange event & if there is a difference - ID is updated & procedure exited.

Hope helpful

Dave

 

[ffionnah]

Woot! that worked.

Yea, I couldn't figure it out either. With the previous code, the spreadsheet froze, of course, and when I let it settle, there were 30k rows of blank data!

Thanks again!

 

[dmt32]

Hi,
most welcome - glad suggestion helped

Dave