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

about to save registered cell only

Hello sir,
Thanks for your code, very nice. Im very new in vb script.
Im using excell to make food order. Ive just to put how many people want to eat & date when i want the food to deliver.

Your code is helpfull, but it will logging all the changes in the sheet. Can you help me, how to make a log for cell that we want only?

Sorry my language sir.

Hi Nick, first of all i want

Hi Nick,

first of all i want to thank you for the great job your are doing here and for the chance you give to unexperience vba users like myself to learn from experienced members like yourself.

I am kinda new in vba so i hope i don't offend you with my questions.

I tried your code from above in one of my excel tables and I recieved a Runtime error 13. Someone mentioned to me that my data from the excel table in the specific worksheet may not be properly. Could you help me please?

And the secnd question: How do I say when I make a change in my table: for example I add a new line in my table and insert some new name in the blank cell. I mean instead "Bran changed cell B2 with "Name"...Bran added the new line 50 (for example) and changed the cell A50 from Blank to "Something"

Protect the audit trail sheet in a shared woorkbook

Dear Nick,

I have a kind of issue regarding auditrail, I made an audit trail with a VBA code quite similar to yours. In order to prevent any change in the audittrail I also add a password in the code (with unprotect/protect). However, this code cannot work in a shared workbook which is an issue as it have to be shared...!
Do you have any idea to make it work once shared??

Many thanks in advance for your help!

Cam

Almir's picture

Use Track Changes History Sheet

Use Track Changes History Sheet - history can not be deleted from the shared workbook.

Almir's picture

Use Track Changes History Sheet

Use Track Changes History Sheet - history can not be deleted from the shared workbook.

Almir's picture

Use Track Changes History Sheet

Use Track Changes History Sheet - history can not be deleted from the shared workbook.

Thank you,

this was more than I expected to find. A very nice component to build a full workflow, with status and logging for several files on a network server. If anyone's interested maybe I post the outcome? Cheers!

Best regards
drsthlm

adding time and date?

Any chance that a time and date can be added to this marco?

Thanks

Almir's picture

Just add this at the end of code (before "End If")

Just add this at the end of code (before "End If")

& " at: " & Time & " on: " & Date

Same thing, but with formatted time and date:

& " at: " & Format(Time,"hh:mm:ss") & " on: " & Format(Date,"dd/mm/yy")

Audit Changes by Dragging Values using Fill Handle

Is it possible to audit changes where the user has changed values using the fill handle? There is a type mismatch when the fill handle is used.
Great post, many thanks.

Nick's picture

we'd very happy to write this

we'd be very happy to write this for you on a consultancy basis..
http://excelexperts.com/contact

tks
Nick

Is there a way to make this report to a .Log file instead?

I\\\'m looking at this code, and I love what it does, but I\\\'ve been asked if there is a way to make this report to a log file instead of an excel sheet, only because the person that is asking wants to read this outside of the excel sheet, just in case something went wrong and corrupted the sheet there is a possibility to see why that happened.

Thanks.

Nick's picture

we\'d very happy to write

we'd be very happy to write this for you on a consultancy basis..
http://excelexperts.com/contact

tks
Nick

writing to access

Hi nik, i have an audit trail which writes changes to an access database, it is all fine, excpept i need to know how to send the previous cell value and previous formula value to the database. It works fine when sending it to another workbook/worksheet, just not to a databse

here is my code so far:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim Cn As ADODB.Connection
Dim oCm As ADODB.Command

Dim logDate As String
Dim logTime As String
Dim logAuthor As String
Dim logWorkbook As String
Dim logWorksheet As String
Dim logcellchange As String
Dim logPrev As String
Dim logNew As String
Dim logPrevForm As String
Dim logNewForm As String

Dim sOldAddress As String
Dim vOldValue As Variant
Dim sOldFormula As String

Dim iRecAffected As Integer

logWorkbook = ThisWorkbook.Name
logWorksheet = Sh.Name
logAuthor = Application.UserName
logDate = Format(Now(), "hh:mm:ss")
logTime = Format(Now(), "dd/mmm/yyyy")
logcellchange = Target.Address
'logPrev = Target.Previous.Value
logNew = Target.Value
'logPrevForm = ActiveCell.Value
logNewForm = Target.Formula

If Target.Rows.Count > 1 Then
Set Cn = New ADODB.Connection
Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=G:\log.accdb;Persist Security Info=False"
Cn.ConnectionTimeout = 40
Cn.Open

Set oCm = New ADODB.Command
oCm.ActiveConnection = Cn
oCm.CommandText = "Insert Into AuditTrail (Workbook, Worksheet, Author, DateDetails, TimeDetails, ChangedCell, OldValue, NewValue, OldFormula, NewFormula) Values ('" & logWorkbook & "','" & logWorksheet & "','" & logAuthor & "','" & logDate & "','" & logTime & "','" & logcellchange & "','" & sOldAddress & "','" & logNew & "','" & sOldFormula & "','" & logNewForm & "')"
oCm.Execute iRecAffected
End If

If Target.Columns.Count > 1 Then
Set Cn = New ADODB.Connection
Cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=G:\log.accdb;Persist Security Info=False"
Cn.ConnectionTimeout = 40
Cn.Open

Set oCm = New ADODB.Command
oCm.ActiveConnection = Cn
oCm.CommandText = "Insert Into AuditTrail (Workbook, Worksheet, Author, DateDetails, TimeDetails, ChangedCell, OldValue, NewValue, OldFormula, NewFormula) Values ('" & logWorkbook & "','" & logWorksheet & "','" & logAuthor & "','" & logDate & "','" & logTime & "','" & logcellchange & "','" & sOldAddress & "','" & logNew & "','" & sOldFormula & "','" & logNewForm & "')"
oCm.Execute iRecAffected
End If
End Sub

Auditing a single cell changes

Hi Nick,

We need to audit changes only to a single cell on the spreadsheet. Could you please show the code?

Thank you,

Viki

Nick's picture

add this line at the start of

add this line at the start of the logging code:
if target.address <> Range("RangeToMonitor").address then exit sub

where "RangeToMonitor" is the range you're monitoring...

how about monitor a column or

how about monitor a column or range define ? i mean more than single cell

Nick's picture

can be done.. it's a bit

can be done.. it's a bit involved... for more info, Request a Quote

Vishesh's picture

Chk this url as

Error Only

Hi,

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

Thanks.

Update from a Website

Hello.I have a table who's on a website, and when i click to update in excel it says me error 13.Any solution for this bug?Thanks you very much!

Re:

I have the solution but now why when i update the website table don't write on log the changes?Anybody knows?thanks for your help

what triggers the subroutine?

The code itself totally makes sense; what I don't understand is the link between typing in the cell and kicking off the sub.

Nick's picture

events

Excel traps a number of events like opening a workbook, selecting a worksheet, changing a value on a worksheet etc..
This is inbuilt to Excel..

Inserting rows/columns

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!

Nick's picture

logging column insert

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

Thx!

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
Nick's picture

turn off events

at the start of the code, put:
Application.enableevents = false
and at the end
Application.enableevents = true

Audit trail for Merged Cells

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

Nick's picture

merged cells

see the answer above

Audit Rail

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

Add date to audit trail

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.

This macro is SUPERB!

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

Nick's picture

log changes

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

unprotect at the beginning, and protect at the end.

 

 

Changing multiple cells simultaneously

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

Nick's picture

Changing multiple cells simultaneously

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

 

Changing multiple cells

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

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.

Audit trail for Merged Cells

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

merged cells count as 1, no ?

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

Using selection.mergearea

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

to

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.

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