VBA Tips - Log An Audit Trail

I have an important spreadsheet, which several people have access to and make changes to it.

I have come up with an idea, and would like to keep an AuditTrail so that if something goes horribly wrong with it, we have a record to look back and find out who did it, and when.

So far, i have a script which runs when the selection is changed, and takes a copy of the current row and pastes it onto a sheet called "AuditTrail".

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Limit = Sheets("AuditTrail").Cells(Rows.Count, 1).End(xlUp).Row + 1
Rows(ActiveCell.Row).Copy Destination:=Sheets("AuditTrail").Rows(Limit)
End Sub

The problem with this is that if the user scrolls up and down or left and right, you end up with lots of un-necessary rows on the audit trail... i want it to only copy the row if the content of any of the cells is changed.

Also, i would like to paste the information onto AuditTrail, but not at column A, i would like it pasted at Column C, with Column A and B being the date & time, and the username of the person who made the change.

Can anyone help me out on this please?

Hi,

I need to create an audit trail of a master spreadsheet. That is, every time a value is changed on the master sheet, I want it to log into an audit trail the following information:

Unique ID
Column Heading (there are about 60 possibilties and columns are often being moved around or added so would probably need to reference the actual column headings)
Previous Value
New Value
Date and time
User (nice to have)

I have been trying to scope this out and a couple of questions come to mind.....
- If a new row is added, how will it cope with it? (I am thinking that I could put an answer box asking if the user wishes to submit the change to the log)
- Can the changing of a cell be a trigger?

Does anyone please have any VBA out there that could do the trick or something I could modify?

Thanks as always!

Rich

I am using the below code to run an audit trail for my db. It currently works fine when it comes to changes that are made to field in a a record where there is already date there, but it does not work when there is no previous data, they field is blank, or when they data is completely removed. Does anyone know of a way to alter the code to make it work?

Option Compare Database
Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acTextBox Or .ControlType = acComboBox Or .ControlType = acCheckBox Then
If .OldValue Is Null Then
varBefore = "Blank"
If .Value .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End If
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.Number, vbOKOnly, "Error"
End Sub

How can i add an AUDIT TRAIL to my MSACCESS database or how can i see a users daily activity on using the database?

Hi All:

I am trying to keep track of when a spreadsheet is returned to the sender. What I want is when I click on ht ebutton "Return" that the VBA Code will mark down the time I am sending it.

I need to keep track of when and how many times it was returned. Basically starting in cell A9 I want it to say:

Returned to sender on: mmmm dd yyyy at h:mm:ss AM/PM

eg Returned to sender on : March 15 2011 at 11:21 AM

IF cell A9 is already filled in then I need the info to be placed in cell A10 then A11 etc.

Any idea how to do this?

THANKS
Mark

Hi guys,

Just thinking, would it be possible to identify or track a table/query/form to see who has opened, edited, deleted anything in it? Would be great to catch some unhelpful people.

Thanks

Hi i have this piece of code in my access databse that tracks changes made to 1 form. the code work properly.
I upgrating my databse to SQL using access as the front end application. All forms will be in access and all Tables in SQL. The access DB will be linked to the SQL to access the data.

For some reason the code that worked fine in acces now doesn't work. Here is the code:
[code]
Public Function TrackChanges()
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Dim strCtl As String
strCtl = Me.ActiveControl.Name
'strCtl = ActiveControl.Name
strSQL = "SELECT Audit.* FROM Audit;"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If rs.RecordCount > 0 Then rs.MoveLast
With rs
.AddNew
rs!FormName = Me.Name
rs!ControlName = strCtl
rs!DateChanged = Date
rs!PriorInfo = Me.ActiveControl.OldValue
rs!NewInfo = Me.ActiveControl.Value
rs!CurrentUser = fOSUserName
rs!ProjectID = Me.ProjectID
rs!ID = Me.ID
.Update
End With

Set db = Nothing
Set rs = Nothing
End Function

[code/]
this is the error message i get:

"The expression Before Update as the event as gthe event property setting produced the following error:"
The expression may not result in the name of a macro, the name of a user-defined function, or [event Procedure]

Any ideas why?

Hi,

I am looking to install and audit trail on an excel spreadsheet so that each time a cell is changed on the master data sheet, it updates a log. A member of this community was kind enough to offer the solution I have pasted below and I am looking to refine it a little.

In the master spreadsheet, I have a column heading row (row 8) and I want to take the value from this row of the cell that was changed - so, for example, if I changed a project name (with a project ID of 1) in the master to "Project X" from "Project Y", I would like to display the following information on the audit trail.

Project ID = 1
The heading of the cell that was changed -in this case Project Name
Old Value = Project Y
New Value = Project X
Date/Time etc (which I can take from below

I am taking the time to learn VBA but need to implement this asap - I am not sure how to reference the heading.......

Thanks as always,

Rich

__________________________________________________

First create a module with a public variable to hold the old value of any cell that the user is working on.

Module1
Code:
Public strOldValue As String


Then on the master worksheet, I am assuming Sheet1 and the Audit sheet is sheet2.

Sheet1
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim intCount As Integer

Sheet2.Range("$A$2").EntireRow.Insert
If Sheet2.Range("$A$3").Value = "" Then
intCount = 1
Else
intCount = Sheet2.Range("$A$3").Value + 1
End If

Sheet2.Range("$A$2").Value = intCount
Sheet2.Range("$B$2").Value = Now
Sheet2.Range("$C$2").Value = Module1.strOldValue
Sheet2.Range("$D$2").Value = Target.Value
Sheet2.Range("$E$2").Value = Application.UserName

End Sub

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

Hi Everyone!

I found the following code on another forum I am not registered to! It creates an audit trail for any changes I make to a spreadsheet.

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

What I can't get the code to do is recognise if a formula/function is changed /added.

Please can anyone help with any additional coding I need.

Many thanks in advance!

I am using code obtained form this forum to maintain an audit when values are changed using controls on a form. The code is basically this:

Function Audit()

Dim strSQL As String
Dim myForm As Form
Dim ctl As Control
Dim ctlName As String

Set myForm = Screen.ActiveForm

For Each ctl In myForm.Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox

'Some controls can't be audited (calculated controls?) so name has
'been changed to begin with SKIPAUDIT for these controls to prevent error
ctlName = ctl.Name
If Mid(ctlName, 1, 9) = "SKIPAUDIT" Then GoTo nextctl:

' If the control was null and is still null skip to next ctl
If IsNull(ctl.Value) And IsNull(ctl.OldValue) Then GoTo nextctl:

' If the value isn't changed OR there isn't a name, skip it all otherwise build SQL statement (strSQL)
If Len(ctl.Name) > 0 And ctl.Value ctl.OldValue Or IsNull(ctl.OldValue) Or IsNull(ctl.Value) Then
strSQL = "INSERT INTO tblAudit ([User], [Date], [Project], [ChangedField], [OldData], [NewData])"
strSQL = strSQL & "SELECT "
strSQL = strSQL & "'" & Environ("username") & "', "
strSQL = strSQL & "'" & Format(Date, "dd/mm/yyyy") & "', "
strSQL = strSQL & "'" & myForm!ID_MAIN & "', "
strSQL = strSQL & "'" & ctl.Name & "', "

'If old value is blank then add word "Blank" to OldData field otherwise use OldValue
If IsNull(ctl.OldValue) Or Len(ctl.OldValue) = 0 Then
strSQL = strSQL & "'Blank', "
Else
'following line allows users to type ' or " without error
strSQL = strSQL & "'" & Replace(Replace(ctl.OldValue, Chr(34), ""), "'", "") & "', "
End If

'If value is blank then add word "Blank" to NewData field otherwise use Value
If IsNull(ctl.Value) Or Len(ctl.Value) = 0 Then
strSQL = strSQL & "'Blank'"
'following line allows users to type ' or " without error
Else: strSQL = strSQL & "'" & Replace(Replace(ctl.Value, Chr(34), ""), "'", "") & "' "
End If

'Turn warnings off (to eliminate the Append row warning)
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If

End Select
nextctl:
Next ctl

trynextctl:
Exit Function

End Function

This works fine whenever a value changes on the main form but the form also has a sub-form and I cannot work out how I can get this audit routine to pick up changed values on the sub-form also - can anybody help.

P.S. I like the new look forum but I can't see any tags for marking code to stand out from ordinary text, is this no longer possible?