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"

        ' Create headers
        logSheet.Cells(1, 1).Value = "Timestamp"
        logSheet.Cells(1, 2).Value = "User"
        logSheet.Cells(1, 3).Value = "Sheet"
        logSheet.Cells(1, 4).Value = "Cell"
        logSheet.Cells(1, 5).Value = "Old Value"
        logSheet.Cells(1, 6).Value = "New Value"
        logSheet.Cells(1, 7).Value = "Change Type"

        ' Format headers
        With logSheet.Range("A1:G1")
            .Font.Bold = True
            .Interior.Color = RGB(200, 230, 255)
        End With
    End If

    ' Find next empty row in log
    Dim nextRow As Long
    nextRow = logSheet.Cells(logSheet.Rows.Count, "A").End(xlUp).Row + 1

    ' Determine change type
    Dim changeType As String
    If IsEmpty(oldVal) Then
        changeType = "Added"
    ElseIf IsEmpty(newVal) Then
        changeType = "Deleted"
    Else
        changeType = "Modified"
    End If

    ' Write log entry
    logSheet.Cells(nextRow, 1).Value = Now
    logSheet.Cells(nextRow, 2).Value = Application.UserName
    logSheet.Cells(nextRow, 3).Value = changedCell.Parent.Name
    logSheet.Cells(nextRow, 4).Value = changedCell.Address(False, False)
    logSheet.Cells(nextRow, 5).Value = oldVal
    logSheet.Cells(nextRow, 6).Value = newVal
    logSheet.Cells(nextRow, 7).Value = changeType

    ' Format timestamp
    logSheet.Cells(nextRow, 1).NumberFormat = "dd/mm/yyyy hh:mm:ss"

    Exit Sub

ErrorHandler:
    MsgBox "Error writing to audit log: " & Err.Description, vbCritical
End Sub

Sub SearchAuditLog()
    ' Search audit log for specific cell or user
    On Error GoTo ErrorHandler

    Dim logSheet As Worksheet
    Set logSheet = ThisWorkbook.Sheets("AuditLog")

    Dim searchCriteria As String
    searchCriteria = InputBox("Enter cell address or username to search:", "Search Audit Log")

    If searchCriteria = "" Then Exit Sub

    Dim lastRow As Long
    lastRow = logSheet.Cells(logSheet.Rows.Count, "A").End(xlUp).Row

    Dim results As String
    results = "Search results for '" & searchCriteria & "':" & vbCrLf & vbCrLf

    Dim foundCount As Integer
    foundCount = 0

    Dim i As Long
    For i = 2 To lastRow
        If InStr(1, logSheet.Cells(i, 4).Value, searchCriteria, vbTextCompare) > 0 Or _
           InStr(1, logSheet.Cells(i, 2).Value, searchCriteria, vbTextCompare) > 0 Then

            results = results & logSheet.Cells(i, 1).Value & " - " & _
                     logSheet.Cells(i, 4).Value & " by " & _
                     logSheet.Cells(i, 2).Value & " (" & _
                     logSheet.Cells(i, 7).Value & ")" & vbCrLf

            foundCount = foundCount + 1

            If foundCount >= 10 Then
                results = results & vbCrLf & "... and more (showing first 10 results)"
                Exit For
            End If
        End If
    Next i

    If foundCount = 0 Then
        results = "No changes found for '" & searchCriteria & "'"
    End If

    MsgBox results, vbInformation, "Audit Log Search"

    Exit Sub

ErrorHandler:
    MsgBox "Error searching audit log: " & Err.Description, vbCritical
End Sub

Sub ExportAuditLog()
    ' Export audit log to CSV file
    On Error GoTo ErrorHandler

    Dim logSheet As Worksheet
    Set logSheet = ThisWorkbook.Sheets("AuditLog")

    Dim filePath As String
    filePath = ThisWorkbook.Path & "AuditLog_" & Format(Now, "yyyymmdd_hhmmss") & ".csv"

    ' Export to CSV
    logSheet.Copy
    ActiveWorkbook.SaveAs Filename:=filePath, FileFormat:=xlCSV
    ActiveWorkbook.Close SaveChanges:=False

    MsgBox "Audit log exported to:" & vbCrLf & filePath, vbInformation

    Exit Sub

ErrorHandler:
    MsgBox "Error exporting audit log: " & Err.Description, vbCritical
End Sub