19. VBA Tips - Log An Audit Trail

Nick's picture


Logging an audit trail of your changes can be useful, and can be done with a small amount of VBA... 

Here's our data:

log-an-audit-trail

Here's a screen shot of what we're trying to achieve:

log-an-audit-trail

Here's the code to do it (put in the worksheet's macro module):

log-an-audit-trail

 

Explanation:

  1. PreviousValue is a variable that we Dim outside the sub routines so that it's available to both routines
  2. When you select a different cell, PreviousValue is set to the value of the cell that you have selected
    • This is set via the Worksheet_SelectionChange event
  3. When you change a cell's value, the Worksheet_Change sub routine is run and it compares the new value (Target.value) with PreviousValue... logging if there has been a change. 
  4. The Log sheet contains details of the changes including the name of the person who changed the cell, what cell was changed, and what it went from and to.

Download sheet to practise how to Log An Audit Trail in Excel

Training Video on how to Log An Audit Trail in Excel:

AttachmentSize
log-an-audit-trail.xls40 KB

Audit trailing

Nick, I am trying to place an audit trail into a document using the code you supplied (with a little variation):
Dim PreviousValue
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
For Each thecell In Target
Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _
Format(Now, "dd mmm yyyy at hh:mm:ss") & " - " & Application.UserName & " changed cell " & Target.Address _
& " to " & thecell.Value
Next
Exit Sub
End If
 
If Target.Value <> PreviousValue Then
Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).ValueValue = _
Format(Now, "dd mmm yyyy at hh:mm:ss") & " - " & Application.UserName & " changed cell " & Target.Address _
& " from " & PreviousValue & " to " & Target.Value
End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
 
However, as the code now sits within a workbook which uses a input form which has the following code already
 
Sub SubmitRisk()
'

Sheets("Register Actions").Select
Rows("6:6").Select
Selection.Insert Shift:=xlDown
Selection.Interior.ColorIndex = 2
Selection.Font.ColorIndex = 0
Selection.Font.Bold = False
 
Sheets("Input form").Select
Rows("139:139").Select
Selection.Copy
 
Sheets("Register Actions").Select
Rows("6:6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
Range("O7").Select
Application.CutCopyMode = False
Selection.Copy
Range("O6").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Input form").Select
Range("A7").Select
 
Range("E10:H10,E12:H12,E14:H14,E16:O20,E22:H22,E24:H24,E26:H26, _
E28:H28,E30:H30,E32:H32,E37:O42,E50:O54,E56:H56,E58:H58,E60:H60 _
,E62:O66,E69:G69,J69:O69,E71:F71,K71:O71,E73:G73,K73,M73,E75:G75 _
,J75:O75,E77:G77,J77:O77,H79:O79,E81:G81,J81:O81" ).Select
Selection.ClearContents
Range("D51").Activate
Selection.ClearContents
Range("A7").Select
End Sub
Sub ClearForm()
'
'

'
Range("E10:H10").Select
Selection.ClearContents
Range("E12:H12").Select
Selection.ClearContents
Range("E14:H14").Select
Selection.ClearContents
Range("E16:O20").Select
Selection.ClearContents
Range("E22:H22").Select
Selection.ClearContents
Range("E24:H24").Select
Selection.ClearContents
Range("E26:H26").Select
Selection.ClearContents
Range("E28:H28").Select
Selection.ClearContents
Range("E30:H30").Select
Selection.ClearContents
Range("E32:H32").Select
Selection.ClearContents
Range("E37:O42").Select
Selection.ClearContents
Range("E50:H54").Select
Selection.ClearContents
Range("E56:H56").Select
Selection.ClearContents
Range("E58:H58").Select
Selection.ClearContents
Range("E60:H60").Select
Selection.ClearContents
Range("E62:O66").Select
Selection.ClearContents
Range("E69:G69").Select
Selection.ClearContents
Range("E71:F71").Select
Selection.ClearContents
Range("K71:O71").Select
Selection.ClearContents
Range("E73:G73").Select
Selection.ClearContents
Range("K73").Select
Selection.ClearContents
Range("M73").Select
Selection.ClearContents
Range("E75:G75").Select
Selection.ClearContents
Range("J75:O75").Select
Selection.ClearContents
Range("E77:G77").Select
Selection.ClearContents
Range("J77:O77").Select
Selection.ClearContents
Range("H79:O79").Select
Selection.ClearContents
Range("E81:G81").Select
Selection.ClearContents
Range("J81:O81").Select
Selection.ClearContents
 
Range("A7").Select
End Sub
it effectively puts in 16000 lines of auditing text into the "Log" sheet every time the submit data button is pressed and the SubmitRisk() routine is run. Is there anyway to vary the code so that as the audit routine is running, it skips any cell returning a zero value, so only the cells with a value that was zero and now has been changed to zero are not returned? Otherwise the code works great Regards Mark
Nick's picture

Log an audit trail

I think this might be what you want then:

Change:

If Target.Value <> PreviousValue Then

to:

If Target.Value <> PreviousValue and Target.Value <> 0 Then

code for logging the changes in a workbook

is it possible for you to publish a code that logging the changes in the entire workbook, and not only in one worksheet??

regards,
Ziv

Nick's picture

code for logging the changes in a workbook

Hi

All you have to do is to add the code to each worksheet you want to log changes to.

... and if you want to add the worksheet name, change the code to:

        Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _
            Application.UserName & " changed cell " & ActiveSheet.Name & Target.Address _
            & " from " & PreviousValue & " to " & Target.Value

Nick

 

Vishesh's picture

Following code in

Following code in Thisworkbook macro module can log the changes in whole workbook except the one named 'Log' for logging.


Dim PreviousValue

 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Sh.Name = "Log" Then Exit Sub

    If Target.Value <> PreviousValue Then

        Application.EnableEvents = False

        Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _

            Application.UserName & " changed cell " & Sh.Name & "." & Target.Address _

            & " from " & PreviousValue & " to " & Target.Value

            Application.EnableEvents = True

    End If

End Sub

 

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    PreviousValue = Target.Value

End Sub

 

code for logging the changes in a workbook

Hi Nick, I'm trying to log the changes to log a file. Everything works fine except for the previousValue. When the workbook loads, the previousValue is 0 (read empty) and from then on he will put in the previousValue the contents of the cell I just changed. How can I realy get the previous value from a cell? This is my code: i a module i've put:
Option Explicit
 
Public Function LogInformation(LogMessage$)
On Error GoTo MakeFolder
Entry:
Open "F:\Log\" & Left(ThisWorkbook.Name, _
Len(ThisWorkbook.Name) - 4) & _
".Log" For Append As #1
Print #1, LogMessage
Close #1
Exit Function
MakeFolder:
MkDir "F:\Log\"
Resume Entry
End Function
In ThisWorkbook i've put:
Option Explicit
Dim PreviousValue
Dim thecell
Private Sub Workbook_Open()
LogInformation "Opened by " & Application.UserName & _
" " & Format(Now, "dd mmm yyyy hh:mm:ss")
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
For Each thecell In Target
LogInformation "Changed by " & Application.UserName & " " & Format(Now, "dd mmm yyyy hh:mm:ss") & _
": " & ActiveSheet.Name & Target.Address & " to " & thecell.Value
Next
Exit Sub
End If
 
If Target.Value <> PreviousValue Then
LogInformation "Changed by " & Application.UserName & " " & Format(Now, "dd mmm yyyy hh:mm:ss") & ": " & _
ActiveSheet.Name & Target.Address & " from " & PreviousValue & " to " & Target.Value
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub
 
Private Sub Workbook_BeforePrint(Cancel As Boolean)
LogInformation ActiveSheet.Name & "Printed: " & _
" " & Format(Now, "dd mmm yyyy hh:mm:ss")
End Sub
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
LogInformation "Saved by " & Application.UserName & _
" " & Format(Now, "dd mmm yyyy hh:mm:ss")
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
LogInformation "Closed by " & Application.UserName & _
" " & Format(Now, "dd mmm yyyy hh:mm:ss")
End Sub
Can you find what's wrong?
Nick's picture

log changes to file

I think what you're saying is that PreviousValueis not initialised on opening. Try this then:
Private Sub Workbook_Open()
	LogInformation "Opened by " & Application.UserName & _
		" " & Format(Now, "dd mmm yyyy hh:mm:ss")
	PreviousValue = ActiveCell.Value
End Sub