Audit Trail & Change Logger

' Audit Trail & Change Logger
' Place this code in the Worksheet module of the sheet you want to monitor

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Log all changes to monitored range
    On Error GoTo ErrorHandler

    ' Define monitored range (adjust as needed)
    Dim monitorRange As Range
    Set monitorRange = Me.Range("A:E") ' Monitor columns A through E

    ' Check if changed cell is in monitored range
    If Not Intersect(Target, monitorRange) Is Nothing Then
        ' Disable events to prevent recursive calls
        Application.EnableEvents = False
        Application.ScreenUpdating = False

        ' Get the old value (stored in undo stack)
        Dim oldValue As Variant
        Application.Undo
        oldValue = Target.Value
        Target.Value = Target.Value ' Redo the change

        ' Log the change
        Call LogChange(Target, oldValue, Target.Value)

        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If

    Exit Sub

ErrorHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Error logging change: " & Err.Description, vbCritical
End Sub

Sub LogChange(changedCell As Range, oldVal As Variant, newVal As Variant)
    ' Write change to audit log sheet
    On Error GoTo ErrorHandler

    Dim logSheet As Worksheet

    ' Create audit log sheet if it doesn't exist
    On Error Resume Next
    Set logSheet = ThisWorkbook.Sheets("AuditLog")
    On Error GoTo ErrorHandler

    If logSheet Is Nothing Then
        Set logSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        logSheet.Name = "AuditLog"

' ... 123 more lines hidden ...
'
' Sign up for free to view the complete code
' Visit: vbacode.io