The following code is in a Worsheet_Change Event Private Sub Worksheet_Change(ByVal Target As Range)
and works to track changes to all cells in the active worksheet and record them on a separate sheet 'Change Log'. However, I only want it to track changes in ListObjects(2)
.
If changes are made in oList2.DataBodyRange.Columns("A:C")
, it should intersect oList2.HeaderRowRange
. If changes are made in oList2.DataBodyRange.Columns("E:AR")
, it should intersect oList1.DataBodyRange.Rows(1)
.
In addition, every change should be logged in the next row.
I tried changing For Each c In Target
to For Each c In ActiveSheet.ListObjects(2).DataBodyRange
but then I keep getting run-time error "Method 'Undo' of object'_Application' failed". Debugger takes me to the first Application.Undo
.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
For Each c In Target
Dim wb As Workbook
Dim ws2 As Worksheet
Dim NextRow As Long
Set wb = ThisWorkbook
Set ws2 = wb.Worksheets("Change Log")
NextRow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
Dim CellAdd As String
Dim result As String
Dim oList1 As ListObject
Dim oList2 As ListObject
Dim rng As Range
Set oList1 = Me.ListObjects(1)
Set oList2 = Me.ListObjects(2)
If Not Intersect(c.EntireColumn, oList2.DataBodyRange.Columns("A:C")) Is Nothing Then
Set rng = Intersect(c.EntireColumn, oList2.HeaderRowRange)
CellAdd = rng.Address
ElseIf Not Intersect(c.EntireColumn, oList2.DataBodyRange.Columns("E:AR")) Is Nothing Then
Set rng = Intersect(c.EntireColumn, oList1.DataBodyRange.Rows(1))
CellAdd = rng.Address
End If
result = Range(CellAdd).Formula
Dim newValue As String
newValue = c.Value
Application.EnableEvents = False
Application.Undo
oldvalue = c.Value
Application.Undo
Application.EnableEvents = True
sheetname = ActiveSheet.Name
If newValue = "" Then
ws2.Cells(NextRow, 2) = sheetname
ws2.Cells(NextRow, 3) = result
ws2.Cells(NextRow, 4) = Environ("username")
ws2.Cells(NextRow, 5) = Format(Now(), "DD MMMM")
ws2.Cells(NextRow, 6) = "Was changed to **" & "EMPTY" & _
"** from **" & oldvalue & "** by " & Environ("username") & " on" & " " & _
Format(Now(), "DD MMMM, YYYY @ H:MM:ss")
ElseIf oldvalue = 0 Then
ws2.Cells(NextRow, 2) = sheetname
ws2.Cells(NextRow, 3) = result
ws2.Cells(NextRow, 4) = Environ("username")
ws2.Cells(NextRow, 5) = Format(Now(), "DD MMMM")
ws2.Cells(NextRow, 6) = "Was changed to **" & newValue & _
"** from **" & "EMPTY" & "** by " & Environ("username") & " on" & " " & _
Format(Now(), "DD MMMM, YYYY @ H:MM:ss")
ElseIf oldvalue <> 0 Then
ws2.Cells(NextRow, 2) = sheetname
ws2.Cells(NextRow, 3) = result
ws2.Cells(NextRow, 4) = Environ("username")
ws2.Cells(NextRow, 5) = Format(Now(), "DD MMMM")
ws2.Cells(NextRow, 6) = "Was changed to **" & newValue & _
"** from **" & oldvalue & "** by " & Environ("username") & " on" & " " & _
Format(Now(), "DD MMMM, YYYY @ H:MM:ss")
End If
ws2.Columns("B:F").AutoFit
Next c
End Sub
How can I track changes only in ListObjects(2)
and why do I keep getting an error?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsLog As Worksheet, oList2 As ListObject
Dim rng As Range, c As Range, sCol As String
Dim oldvalue, sTo As String, sFrom As String
Dim r As Long
On Error GoTo myerror
Application.EnableEvents = False
Set oList2 = Me.ListObjects(2) '
Set rng = Union(oList2.DataBodyRange.Columns("A:C"), _
oList2.DataBodyRange.Columns("E:AR"))
Set wsLog = ThisWorkbook.Sheets("Change Log")
With wsLog
r = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each c In Target
If Intersect(c, rng) Is Nothing Then
' do nothing
Else
' column header
If c.Column - oList2.DataBodyRange.Column + 1 <= 3 Then
sCol = Intersect(c.EntireColumn, oList2.HeaderRowRange).Formula
Else
sCol = Intersect(c.EntireColumn, Me.ListObjects(1).DataBodyRange.Rows(1)).Formula
End If
Application.Undo
oldvalue = c
Application.Undo
If c.Value = "" Then
sTo = "EMPTY"
sFrom = oldvalue
ElseIf oldvalue = 0 Then
sTo = c.Value
sFrom = "EMPTY"
ElseIf oldvalue <> 0 Then
sTo = c.Value
sFrom = oldvalue
End If
'log it
r = r + 1
.Cells(r, 1) = c.Address
.Cells(r, 2) = Me.Name
.Cells(r, 3) = sCol ' column name
.Cells(r, 4) = Environ("username")
.Cells(r, 5) = Format(Now(), "DD MMMM")
.Cells(r, 6) = "Was changed to **" & sTo & "** from **" _
& sFrom & "** by " & Environ("username") & " on" & " " & _
Format(Now(), "DD MMMM, YYYY @ H:MM:ss")
End If
Next
.Columns("B:F").AutoFit
End With
myerror:
Application.EnableEvents = True
If Err.Number Then MsgBox Err.Number & " " & Err.Description
End Sub