excel-audit-worksheet-changes

Excel - Audit Worksheet Changes

This macro audits worksheet changes.

Excel

  • 7763
  • 1637
  • 1
  • 0
Add to collection
© 2024VBAmacros.net

1 Open MS Excel.

2 Create a blank workbook.


3 Go to Developer's tab > click on "Visual Basic" button or hit Alt + F11.


4 Go to Insert tab > click on "Module" or hit M.


5 Copy the VBA code from below.

6 Paste the code in the newly created module.


7 Go to Run tab > click on "Run Sub/UserForm" or hit F5.


8 That's it!


Advertisement

Code
Option Explicit
'==========================================
' Audit Worksheet Changes
'==========================================
' Set constants
Const liveWorksheet As String = "Live"
Const auditWorksheet As String = "Audit"
Const logWorksheet As String = "Log"
' Catch workbook's open event
Private Sub Workbook_Open()
    ' Set variables
    Dim iRow As Integer
    Dim iCol As Integer
    Dim iLastRow As Long
    ' Get last row
    iLastRow = Worksheets(logWorksheet).Cells(Rows.Count, 1).End(xlUp).Row
    ' Write to audit worksheet
    Worksheets(logWorksheet).Cells(iLastRow + 1, 1) = "Workbook opened by " & Environ("USERNAME") _
       & " on " & Format(Now(), "dd/mm/yyyy") & " at " & Format(Now(), "hh:nn:ss")
    ' Loop through first 100 rows
    For iRow = 1 To 100
        ' Loop through first 50 columns
        For iCol = 1 To 50
            ' Check if values match
            If Worksheets(auditWorksheet).Cells(iRow, iCol).Value <> Worksheets(liveWorksheet).Cells(iRow, iCol).Value Then
                ' Get last row
                iLastRow = Worksheets(logWorksheet).Cells(Rows.Count, 1).End(xlUp).Row
                ' Write the changes
                Worksheets(logWorksheet).Cells(iLastRow + 1, 1) = "Cell(" & CStr(iRow) & "," & CStr(iCol) & ") " _
                    & "changed from '" & Worksheets(auditWorksheet).Cells(iRow, iCol).Value & "' " _
                    & "to '" & Worksheets(liveWorksheet).Cells(iRow, iCol).Value & "'"
                Worksheets(auditWorksheet).Cells(iRow, iCol) = Worksheets(liveWorksheet).Cells(iRow, iCol).Value
            End If
        Next iCol
    Next iRow
    ' Save the changes
    ActiveWorkbook.Save
End Sub
Advertisement


Comments
Sort by:
This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.
VBAmacros.net VBAmacros.net
Code was successfully copied!
VBAmacros.net VBAmacros.net
Please sign in!
VBAmacros.net VBAmacros.net
You've already voted!