19. VBA Tips - Log An Audit Trail

Submitted by Nick on 12 May, 2009 - 17:46

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:

PreviousValue is a variable that we Dim outside the sub routines so that it's available to both routines
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
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.
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:

Attachment	Size
log-an-audit-trail.xls	40 KB

code for logging the changes in a workbook

Submitted by Anonymous on 7 December, 2009 - 19:06.

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

code for logging the changes in a workbook

Submitted by Nick on 8 December, 2009 - 11:07.

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

code for logging the changes in a workbook

Submitted by Anonymous on 15 January, 2010 - 23:22.

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?

log changes to file

Submitted by Nick on 16 January, 2010 - 10:50.

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

Following code in

Submitted by Vishesh on 3 February, 2012 - 18:51.

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

Changing multiple cells simultaneously

Submitted by Anonymous on 13 January, 2010 - 17:26.

Great post, by the way.

Is there any way that the code can be changed to handle copying and pasting more than one cell at a time?

Nick

Changing multiple cells simultaneously

Submitted by Nick on 13 January, 2010 - 17:58.

I don't think it's possible because when you do a large copy and paste, you don't always select the cells before hand. Consequently, you wouldn't be able to work out what the previous value was. You could modify the existing code to say what the value has been changed to though:

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 = _
                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).Value = _
            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

NOTE the result of copying col 1 into col 2:

Nick Vivian changed cell $C$8:$C$10 to Nick

Nick Vivian changed cell $C$8:$C$10 to Paul

Nick Vivian changed cell $C$8:$C$10 to Bob

- you get the same cell address

Audit trailing

Submitted by Anonymous on 24 January, 2010 - 23:24.

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

Log an audit trail

Submitted by Nick on 25 January, 2010 - 10:35.

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

Audit trail for Merged Cells

Submitted by Anonymous on 23 April, 2010 - 12:56.

Hi Nick,

Thanks for the codes. They are very helpful.

In adidition to the code where changes to more than one cell at a time is recorded, is it possible to have a code to audit trail 5 cells, which are merged.

merged cells

Submitted by Anonymous on 24 April, 2010 - 19:20.

merged cells count as 1, no ?

You can pick up all the cells in a merged range, use Selection.MergeArea

Using selection.mergearea

Submitted by Anonymous on 18 August, 2011 - 11:37.

what is the proper syntax for this? how can we use this? I tried using this by changing this original code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
PreviousValue = Target.Value
End Sub

Private Sub Worksheet_SelectionMergeArea(ByVal Target As Range)
PreviousValue = Target.Value
End Sub

-- It seemed to work but then it appears that the logs created are always stuck at the PreviousValue returning a 'blank' value.

Changing multiple cells

Submitted by Anonymous on 20 December, 2011 - 17:18.

Hi Nick,
i input this code and tested it and was working great. I now have entered the spreadsheet again and it no longer records the log. It doesn't give me any errors or anything. I've checked the code and it's exactly the same. Do you know why this would be happening? No one has opened it since. Not sure why it would just stop working as the code is still there.

Thanks,

Did you enable macros when

Submitted by Anonymous on 20 December, 2011 - 17:34.

Did you enable macros when opening ?
Also, are events enabled.. maybe another bit of VBA turns off events.
- try opening in a new Excel session making sure macros are enabled.

This macro is SUPERB!

Submitted by Anonymous on 18 March, 2010 - 19:32.

Is it possible to protect the log worksheet so that users can't modify it? Thanks!

log changes

Submitted by Nick on 19 March, 2010 - 12:10.

yes.. just Record a Macro of protecting and unprotecting the sheet with a password.

unprotect at the beginning, and protect at the end.

Audit trail for Merged Cells

Submitted by Anonymous on 29 April, 2010 - 13:01.

Hi Nick,

Thanks for the codes. They are very helpful.

In addition to the code where changes to more than one cell at a time is recorded, is it possible to have a code to audit trail 5 cells, which are merged.

Thanks,
Naresh

merged cells

Submitted by Nick on 29 April, 2010 - 14:07.

see the answer above

Audit Rail

Submitted by Anonymous on 31 August, 2010 - 08:45.

How can i add a date to the Audit trail code given?

Add date to audit trail

Submitted by Anonymous on 31 August, 2010 - 08:52.

yes, add this line under the existing one:

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

this will add date in col 2.

Thx!

Submitted by Anonymous on 21 July, 2011 - 08:43.

Hi Nick, Great macro, thanks a lot, but I have one little problem. I have spreadsheets which copy all the data from another spreadsheet into this "main" spreadsheet. As the data to be copied is never in the same range (could be more or less lines), the macro I wrote copies everything from columns A - M in my main sheet like this:

    Sheets("IT Import").Select
    ChDir "V:\DATA\Ent van der"
    Workbooks.Open Filename:="V:\DATA\Ent van der\RAL4V5.XLS"
    Columns("A:M").Select
    Selection.Copy
    ThisWorkbook.Activate
    Application.GoTo Reference:="R1C1"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A26").Select
    Application.CutCopyMode = False
    Calculate

However, if I let this macro run while your macro is on, it creates a log entry for each and every cell it is changing, which is (roughly estimated) 13 x 65000 lines. Which is a little bit too much... Do you know how I could solve this? Or, alternatively, instead of keeping track of the change of each cell, would it be possible to keep track of just the persons saving information to my "main" sheet? Thanks a lot, Peter

turn off events

Submitted by Nick on 21 July, 2011 - 21:15.

at the start of the code, put:

Application.enableevents = false

and at the end

Application.enableevents = true

Inserting rows/columns

Submitted by Anonymous on 18 August, 2011 - 10:54.

Hi,

I find your macro quite useful. However, i am having problems when I insert colmns - creates all logs for the created blank cells which is a bit too much. Can the log just say that a new column has been inserted?

Thanks!

logging column insert

Submitted by Nick on 24 August, 2011 - 07:13.

the logging procedure is designed for an end-user system... the end user should not be inserting columns.

Recommend excluding events where the range impacted is more than one cell.

At the start of the sub, put:

if Target.rows.count>1 then exit sub
if Target.columns.count>1 then exit sub

Nick

Anyway I can edit it to log if user entered an invalid data together with the time and data entered?

Thanks.

Chk this url as

Submitted by Vishesh on 7 February, 2012 - 08:01.

Chk this url as well

http://excelexperts.com/cell-content-change-history-comments

Excel / VBA Consultancy

Free Training Videos

Free Spreadsheets

Current Excel / VBA Jobs

Excel / VBA Jobs

Navigation

Who's online

New Excel Experts

19. VBA Tips - Log An Audit Trail

Last viewed:

Recent Blogs

Forums

Recent comments

User login