VBA Code to set up an audit trail in a separate sheet of a workbook.

[jlc29369]

Hello all,

I have the task of setting up an audit trail for all changes that are made to a spreadsheet.
Suppose the spreadsheet has Sheet 1 and a log sheet. I want the log sheet to record all changes made to Sheet 1 by displaying the user name, the change, the old value, the new value, the date, and the time.

Could someone please help me out with this?

 

[JLGWhiz]

The first marco goes in the sheet code module for the sheet where the changes will occur (Sheet 1 per Post #1 ). The second code will go into a public numbered code module (e.g. Module1). The second code is to reset the event trigger if the first code should stop working due to a break in the code before the line that turns events back on. If you name you log sheet something besides "Log" then you will need to make that change in the code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Dim ov As Variant, nv As Variant
nv = Target.Value
Application.Undo
ov = Target.Value
Target = nv
With Sheets("Log")
         On Error GoTo HDL:
        .Cells(Rows.Count, 1).End(xlUp)(2) = Environ("UserName")
        .Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = Target.Parent.Name
        .Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = Target.Address
                If ov = "" Then
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = "Blank"
                Else
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = ov
                End If
                If nv = "" Then
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = "Blank"
                Else
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = nv
                End If
End With
HDL:
    If Err.Number > 0 Then
        MsgBox "The following error occurred:" & Err.Number & vbLf & Err.Description & "."
    End If
Application.EnableEvents = True
End Sub
Sub t()
Application.EnableEvents = True
End Sub

 

[JLGWhiz]

Forgot the date time stamp. This should cover it.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Dim ov As Variant, nv As Variant
nv = Target.Value
Application.Undo
ov = Target.Value
Target = nv
With Sheets("Log")
         On Error GoTo HDL:
        .Cells(Rows.Count, 1).End(xlUp)(2) = Environ("UserName")
        .Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = Target.Parent.Name
        .Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = Target.Address
                If ov = "" Then
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = "Blank"
                Else
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = ov
                End If
                If nv = "" Then
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = "Blank"
                Else
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = nv
                End If
        .Cells(Rows.Count, 1).End(xlUp).Offset(, 5) = Now
        If .Columns(6).ColumnWidth < 15 Then .Columns(6).ColumnWidth = 15
End With
HDL:
    If Err.Number > 0 Then
        MsgBox "The following error occurred:" & Err.Number & vbLf & Err.Description & "."
    End If
Application.EnableEvents = True
End Sub

 

[jlc29369]

Forgot the date time stamp. This should cover it.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Dim ov As Variant, nv As Variant
nv = Target.Value
Application.Undo
ov = Target.Value
Target = nv
With Sheets("Log")
         On Error GoTo HDL:
        .Cells(Rows.Count, 1).End(xlUp)(2) = Environ("UserName")
        .Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = Target.Parent.Name
        .Cells(Rows.Count, 1).End(xlUp).Offset(, 2) = Target.Address
                If ov = "" Then
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = "Blank"
                Else
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = ov
                End If
                If nv = "" Then
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = "Blank"
                Else
                     .Cells(Rows.Count, 1).End(xlUp).Offset(, 4) = nv
                End If
        .Cells(Rows.Count, 1).End(xlUp).Offset(, 5) = Now
        If .Columns(6).ColumnWidth < 15 Then .Columns(6).ColumnWidth = 15
End With
HDL:
    If Err.Number > 0 Then
        MsgBox "The following error occurred:" & Err.Number & vbLf & Err.Description & "."
    End If
Application.EnableEvents = True
End Sub

It works! Except for one thing I forgot to mention. Is it possible for this code to work if the "log" sheet is password protected, or is there some workaround for that? Obviously I don't want users to be able to manipulate the audit trails.

 

[JLGWhiz]

You can do it with a protected sheet, but it is slow and clumsy. As an alternative, you can use the Very Hidden feature to hide the worksheet which can then only be viewed by using VBA to restore visibility. The Excel User Interface will not allow a user to unhide the sheet. The first macro below will hide the worksheet and the second one will allow you to make if visible for viewing. There is no time delay resulting from having to unprotect and re-protect the sheet as users make changes.

Sub secSht()
Sheets("Log").Visible = xlVeryHidden
End Sub


Sub vuSht()
Sheets("Log").Visible = True
End Sub

 

[JLGWhiz]

Forgot to add: Leave the 'Log' sheet unprotected when you make it xlSheetVeryHidden.

 

[jlc29369]

Thank you very much for your help!

 

[Bhargavi]

how do i wrap the columns in the above code?

 

[Bhargavi]

The above code is capturing the change log for clicking in the cell, even if no change is made. is there a way to avoid this from being tracked as a change?