excel-audit-worksheet-changes

Excel - Audit Worksheet Changes

This macro audits worksheet changes.

Excel

  • 2045
  • 501
  • 1
  • 0
Add to collection
© 2021VBAmacros.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.
Advertisement
  • Created
    22-May-2020
  • Last updated
    22-May-2020
Advertisement
VBAmacros.net VBAmacros.net
Code was successfully copied!
VBAmacros.net VBAmacros.net
Please sign in!
VBAmacros.net VBAmacros.net
You've already voted!