VBA Audit Trail

[CodingMonkey]

I only recently started learning how to use VBA code and I'm come to a standstill with one particular code. I'm not too sure where to start and hope someone here is a miracle worker and can help me!

What I'm aiming to achieve:

A hidden, and preferably locked, worksheet that will record username, time/date, what cell, what they changed it from, what they changed it to. Also if it is possible, maybe have the "cell" option be a hyperlink to quickly jump you to that sheet/cell, but we can start simple.

Information about my document thus far:

I have a workbook with 3 sheets: Calibration Entry Form, Calibrations, Audit Trail.

Calibration Entry Form- it is a blank sheet with a button. You click the button, it opens up a coded user entry form. Currently, for testing purposes, it has five categories that you enter and then click "Add Calibration" and it auto-enters the information into a hidden sheet called Calibrations.

Calibrations - hidden sheet with a table that organizes the compiled data from the entry form into table format. I wanted to be able to lock this sheet as well, but there seems to be an issue that once I lock it, data from the entry form can't be entered. Aka it breaks the only bit of coding I've successfully been able to figure out thus far.

Audit Trail - hidden, preferably locked, sheet that will be a simple table that records any and all changes made to the Calibrations sheet. I would like to see that even data entered from the User Form would get added onto this sheet as well, but I'm not sure if that is possible since it is being entered via another code. Sorry, I'm new to this and don't know the potential.


I do currently work with Office 2007 since the corporation I work for hasn't 100% integrated 2016. Don't know if that is vital or not, but wanted to put that information out there.

Thanks in advance for any help!

 

[dchaney]

Re: VBA Audit Trail Help

I was unable to reply to your PM as your inbox is full. Below is the code that I currently use, look this over and see if it will work for you.

in a new module paste the following:

Sub LogFile_One()

lrow = Sheets("Log").Range("A" & Rows.Count).End(xlUp).Row + 1

'***************************************************************************************
'CAPTURE THE OLDVALUE(S) OF CELLS BEING CHANGED                                        *
'***************************************************************************************
With Application
    On Error GoTo ErrHandler
    .EnableEvents = False
    .Undo
    
    If Target.Cells.Count < 15 Then
        For Each c In Selection.Cells
            If OldValue = "" Then
                OldValue = c.Value
            Else
                OldValue = OldValue & ", " & c.Value
            End If
        Next
    ElseIf Target.Cells.Count > 15 Then
        OldValue = "Value in Multiple Cells Deleted"
    Else
        OldValue = Target.Cells(1).Value
    End If
    
    .Undo
    .EnableEvents = True
End With

'***************************************************************************************
'CAPTURE THE NEWVALUE(S) OF CELLS BEING CHANGED                                        *
'***************************************************************************************
If Target.Cells.Count > 1 Then
    For Each c In Selection.Cells
        If NewValue = "" Then
            NewValue = c.Value
        Else
            NewValue = NewValue & ", " & c.Value
        End If
    Next
Else
    NewValue = Target.Cells(1).Value
End If

'***************************************************************************************
'POPULATE THE OLDVALUE(S) & NEWVALUE(S) OF CELLS BEING CHANGED INTO LOG SHEET          *
'***************************************************************************************
With Sheets("Log")
    .Range("A" & lrow) = (Environ$("Username"))
    .Range("B" & lrow) = time
    .Range("C" & lrow) = Date
    .Range("D" & lrow) = OldValue
    .Range("E" & lrow) = NewValue
    .Range("F" & lrow) = Target.Address
End With

ErrHandler:
Application.EnableEvents = True

If Err.Number <> 0 Then
    MsgBox "Error: " & Err.Number & vbNewLine & Err.Description
End If

End Sub

Hope this helps you or at least points you in the right direction. I am sure there are cleaner ways to do this, but I am still learning myself and this works for me.

 

[CodingMonkey]

Re: VBA Audit Trail Help

Thanks for the response!

I started a new module and inputted the code. Changed the lrow = Sheets("Log") to lrow = Sheets("Audit") to match my workbook.

I input code from my User Form, then switch to "Calibrations" sheet and make a random change, then go to Macros > LogFile_One > Run.

I get the following error code:
Error: 424
Object required

 

[dchaney]

Re: VBA Audit Trail Help

Post your modified code please (be sure to use the code tags (the # in the title bar)

 

[CodingMonkey]

Re: VBA Audit Trail Help

I tweaked and manipulated the coding and I think I got it 100% up-and-running. Thanks again for the quick response and the amazing help!

 

[dchaney]

Re: VBA Audit Trail Help

My pleasure

 

[BSAGAERT]

Re: VBA Audit Trail Help

Hi, I want to achieve the same thing and get the same error 424. What did you change to make it work, CondingMonkey?

 

[CodingMonkey]

Re: VBA Audit Trail Help

For future viewers,

The current code I am running for my audit trail is as follows. I have gotten responses that it creates an error code for some users, but I have created two new workbooks and have tested the code and it works flawlessly every time. It shouldn't matter, but I am running Office 2016.

Dim PreviousValue As String
Dim CurrentValue As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    LogChange ("Closed " & ActiveWorkbook.Name)
End Sub


Private Sub Workbook_BeforePrint(Cancel As Boolean)
    LogChange ("Sheet Printed: " & ActiveWorkbook.Name)
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    LogChange ("Saved " & ActiveWorkbook.Name)
End Sub


Private Sub Workbook_NewChart(ByVal Ch As Chart)
    LogChange ("New Chart Created")
End Sub


Private Sub Workbook_NewSheet(ByVal Sh As Object)
    LogChange ("New Sheet Created")
End Sub
Private Sub Workbook_Open()
    LogChange ("Opened " & ActiveWorkbook.Name)
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    LogChange ("Sheet Activated")
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    CurrentValue = ""


    If Sh.Name = "Log" Then Exit Sub


    On Error Resume Next
    If Err.Number = 13 Then
        PreviousValue = 0
    Else
        CurrentValue = Target.Value
    End If
    On Error GoTo 0


    If PreviousValue = "" And CurrentValue = "" Then Exit Sub


    If VarType(PreviousValue) = VarType(CurrentValue) Then
        If CurrentValue <> PreviousValue Then
            If Err.Number = 13 Then
               PreviousValue = 0
            End If


            If PreviousValue = "" Then
                PreviousValue = "EMPTY"
            End If
            If CurrentValue = "" Then
                CurrentValue = "EMPTY"
            End If


            LogChange (Target.Address & " changed from " & PreviousValue & " to " & CurrentValue)
          End If
    End If
    PreviousValue = 0
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Err.Number = 7 Then Exit Sub
    
    PreviousValue = Target.Value
End Sub

 

[Oredo]

Re: VBA Audit Trail Help

Hello,

As I'm noob to vba coding and looking for simple solution to make audit trail for 1 sheet. Can i adopt your code to do:
1. I have 1 sheet (Action Items) which i need to track. it is a table with the project cases. New cases can be added (inserted rows)

2. The audit sheet (lets call it Audit) would capture all changes made to the "Action items" sheet.

How i imagine, i would like audit trail in "Audit sheet" come out like this:

case 1 date of change old value new value changes made by
date of change old value new value changes made by
date of change old value new value changes made by
will create new row if changes made to case 1

case 2 date of change old value new value changes made by
date of change old value new value changes made by
same here will keep creating new row for case 2 changes
And it will continue for all the cases. So in short it will log each change for each case ID, if new case is added, it will only show comment something like - "New case ID" added to the "Action items"

Again, i apologise, as i have zero to none knowledge in vba, and while reading tutorials, i would appreciate the help.

 

[CodingMonkey]

Re: VBA Audit Trail Help

Oredo,

So sorry for my delay in response, attempted to respond to your personal message, but your inbox was full. Been out of country on some work and been swamped at that. I took a look at your question and was a little confused on what you were asking in general. The code I wrote was more along the lines of what my environment needs - Date / Name / Sheet / Change To / Change From format. Obviously, you can switch this out with whatever you need tracked, but it should work for any situation you throw at it as long as the cells and titles match up.

The audit trail, as current, will collect any sheet activations, sheet changes, cell changes, etc. that happen in the entire workbook. So if you had two different sheets for each of your cases, it would track each individually, and you could then apply a filter on the audit trail that you could filter "Case 1" / "Case 2" and narrow down all of the audit trail to your desire. You will place the code that I uploaded within the workbook, not the sheet for the audit trail. You will then create a module, with the following code:

Public Function LogChange(Optional Message)    
    Dim StartTime As Double
    Dim TempArray() As Variant
    Dim TheRange As Range
    
    Application.ScreenUpdating = False
    
    ' How Long Does This Take to Run?
    ' StartTime = Timer


    ' Redimension temporary array
    ReDim TempArray(0, 5)


    ' Which row is this going in?
    LastRow = Sheets("Log").UsedRange.Rows.Count + 1
        
    ' Set the destination range
    FirstCell = "A" & LastRow
    LastCell = "E" & LastRow


    'Store the tracked data in an array
    TempArray(0, 0) = FormatDateTime(Now, vbShortDate)
    TempArray(0, 1) = FormatDateTime(Now, vbLongTime)
    TempArray(0, 2) = Environ$("username")
    TempArray(0, 3) = ActiveSheet.Name
    TempArray(0, 4) = Message


    ' Transfer temporary array to worksheet
    Set TheRange = Sheets("Log").Range(FirstCell, LastCell)
    TheRange.Value = TempArray


    ' Display elapsed time
    'MsgBox Format(Timer - StartTime, "00.00") & " seconds"
    Application.ScreenUpdating = True
End Function

I named the module TrackChange, but you can name it whatever you would like.

If you run into any issues, I can take a look at the code on my end and help out in any way possible. I'm still a tad new to VBA compared to some users on this forum, but will do my best to assist you.

Hope everything in the code works for you, if not I'll hear from you soon!

Have a great day, and good luck!