Track Changes Automatically in Worksheet with VBA

Track Changes Automatically in Worksheet with VBA
Track Changes Automatically in Worksheet with VBA

We can track changes automatically in an Excel worksheet with VBA. We capture the sheet and cell address where the change is made, the old or original value, the changed value, the name of the person who made the change, the date and time the change was made and a back-link to the changed cell address is also created.

Watch the Excel training video:

Watch the video on YouTube.

Here’s the complete VBA code to track changes automatically:

Dim oldValue As String
Dim oldAddress As String
Private Sub Workbook_Open()
Sheets(“LogDetails”).Visible = xlSheetVeryHidden
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Sheets(“LogDetails”).Visible = xlSheetVisible Then
Sheets(“LogDetails”).Visible = xlSheetVeryHidden
Sheets(“LogDetails”).Visible = xlSheetVisible
End If
Target.Offset(1, 1).Select
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sSheetName As String
sSheetName = “Data”
If ActiveSheet.Name <> “LogDetails” Then
Application.EnableEvents = False
Sheets(“LogDetails”).Range(“A” & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & ” – ” & Target.Address(0, 0)
Sheets(“LogDetails”).Range(“A” & Rows.Count).End(xlUp).Offset(0, 1).Value = oldValue
Sheets(“LogDetails”).Range(“A” & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Value
Sheets(“LogDetails”).Range(“A” & Rows.Count).End(xlUp).Offset(0, 3).Value = Environ(“username”)
Sheets(“LogDetails”).Range(“A” & Rows.Count).End(xlUp).Offset(0, 4).Value = Now
Sheets(“LogDetails”).Hyperlinks.Add Anchor:=Sheets(“LogDetails”).Range(“A” & Rows.Count).End(xlUp).Offset(0, 5), Address:=””, SubAddress:=”‘” & sSheetName & “‘!” & oldAddress, TextToDisplay:=oldAddress

Application.EnableEvents = True
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
oldValue = Target.Value
oldAddress = Target.Address
End Sub

Download a sample file: