Audit Log VBA Code Microsoft 365

[Deosculate]

Hi everybody,

I've tried a bunch of different codes I've found online for creating an audit log that tracks any changes within a workbook but either they do not work, or they create an endless loop that eventually crashes Excel. Can anyone help me with some code that will track any changes made within the entire workbook, specifically the user name, date, time and the changes made and add these to a worksheet called Log?

Thanks in advance!

 

[Candyman8019]

Here's what I use for audit. I have a separate sheet that I hide that contains the audit log. There is one cell designated as the 'LastRowInd' that updates based on formula as shown below.

Business Analyst Workbook - Contact Center.xlsm
	A	B	C	D	E	F	G	H
1	Defect Change Audit Log						LastRow	705
2
3
4
5
6
7	Date Changed	Changed By	Issue #	Issue Description	Related Test Case	Severity	State	Submitted by
Defect Audit

Cell Formulas
Range	Formula
H1	H1	=SUMPRODUCT(MAX((A7:A999920<>"")*ROW(A7:A999920)))

The script in each sheet you want audited would look something like the following:

Private Sub worksheet_change(ByVal target As Range)
If Not Intersect(target, Sheet11.Range("B10:J1000")) Is Nothing Then

   Sheet12.Range("A" & Sheet12.Range("LastRowInd").Value + 1) = Now
   Sheet12.Range("B" & Sheet12.Range("LastRowInd").Value) = Environ("UserName")
   Sheet12.Range("C" & Sheet12.Range("LastRowInd").Value & ":O" & Sheet12.Range("LastRowInd").Value).Value = Sheet11.Range("A" & target.Row & ":M" & target.Row).Value

End If

End Sub

This will add the change date, user ID of the person who made the change, and the corresponding record details.

 

[Candyman8019]

If you prefer not to use a cell to indicate the last row, you could do something like this:

dim lastrow as long
If Not Intersect(target, Sheet11.Range("B10:J1000")) Is Nothing Then
lastrow = Sheet12.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1


   Sheet12.Range("A" & lastrow).Value = Now
   Sheet12.Range("B" & lastrow).Value = Environ("UserName")
   Sheet12.Range("C" & lastrow & ":O" & lastrow).Value = Sheet11.Range("A" & target.Row & ":M" & target.Row).Value

End If