Excel VBA code for audit trail

[Sunnygreet]

Can someone help setup audit trail (a record of the changes that have been made to a excel file). Basically, we would like to keep a log of who changed what and when (Date & Time) on the excel file. Our current excel file or computer doesn’t have user login. Hence ,we need VBA code that would ask for user details (First and last name) when a user attempts to change the cell.

 

[sijpie]

It will be a lot more user friendly if the users only needs to enter their details on opening the workbook.
Further it is quite easy to do, but there is some work involved in order to make it reasonable fool proof.

In essence:
If a user does not enable the macros, then the workbook should be locked for writing, with a message mentioning this
Each worksheet will need to contain the macro in its module.
A hidden empty template sheet with the macro is required, in case a user adds a new sheet

Weakness:
A savvy excel user can always break the system
A user can enter anyone's name in the entry box
If more users use only one PC then you are stuck with asking each time, although this could be improved by not asking when the changes are done within say a minute of each other.
Or the users need to close Excel when they are finished.
Improvements:
If the users all use their own PC, then the user initials can be extracted from Excel, or from Windows.

OK here goes:

1. Add a new sheet to the workbook
2. Name it 'UserLog'
3. add the following in the sheet

4. You need to add some named ranges:
A5: Log
E3: CurrentUser
G3: DateTime

5. Add a new sheet to the workbook
6. Name it 'Warning'
7. Add some text to it with appropriate font size and colours to tell the user that macro's need to be enabled in order to make changes

8. Add a new sheet to the workbook
9. Name it 'NewShtTemplate'
10. Right click on the name tab and select 'View Code'
11. Paste the following code in the VBA window that has opened.

Option Explicit

Const iDelay As Integer = 1     '<<< Delay in minutes before name is asked again

Dim vPreviousVal As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Store current value of cell, any time a cell gets selected
    If Target.Cells.Count = 1 Then
        vPreviousVal = Target.Value
    Else
        vPreviousVal = "Unknown"        ' Multiple cells selected
    End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
'Store changes to a log sheet. _
 >> There has to be a worksheet with the name 'UserLog' (the log sheet may be hidden) _
 >> In this sheet UserLog cell E3 is named 'CurrentUser', _
 >> and cell E5 is named 'DateTime'. _
 >> Also a few rows down the log starts, with the top left cell _
 >> of the header named 'Log'. _
 >> The log is 7 columns wide with headings: _
 >> First   Last    Sheet   Cell address    Previous    New    Date Time

 
    Dim sN As String
    Dim vL(1 To 7) As Variant, vU(1 To 3) As Variant

    'The additional row to the log is built up i an array vL
    vL(1) = Sheets("UserLog").Range("CurrentUser")
    vL(2) = Sheets("UserLog").Range("CurrentUser").Offset(0, 1)
    
    
    
    If Now() > Sheets("UserLog").Range("DateTime") + iDelay / (24 * 60) Then
GetName:
        sN = InputBox("Enter First/Last name (separated by / (slash))", _
            Title:="User name", Default:=vL(1) & "/" & vL(2))
        If Len(sN) And sN Like "*/*" Then
            vL(1) = Split(sN, "/")(0)
            vL(2) = Split(sN, "/")(1)
            ' The changes to username and date stamp are built up in array vU
            vU(1) = vL(1)
            vU(2) = vL(2)
            vU(3) = Now()
            'write vU to the log sheet
            Sheets("UserLog").Range("CurrentUser").Resize(1, 3).Value = vU
        Else
            GoTo GetName
        End If
    Else
        vU(3) = Now()
    End If
    
    'add change to log
    vL(3) = Me.Name
    vL(4) = Target.Address
    vL(5) = vPreviousVal
    vL(6) = Target.Value
    vL(7) = vU(3)
    vU(3) = vL(7)
    'write vL to the log sheet
    With Sheets("UserLog").Range("Log").CurrentRegion
        .Offset(.Rows.Count, 0).Resize(1, 7).Value = vL
    End With
    
End Sub

12. While you are in the VBA editor, in the left top window, you will see the list of sheets in the workbook and 'ThisWorkbook'
Double click on ThisWorkbook to open the workbook module.

Now paste the following code in the window.

Option Explicit

Const sWBPW  As String = "MyPW"     '<<<< modify to suit. Record it somewhere safe!!!

Dim wsActive As Worksheet


Private Sub Workbook_NewSheet(ByVal Sh As Object)
' When the user adds a new sheet, this macro copies
' the hidden sheet 'NewShtTemplate'. This template sheet can
' contain event macros, so that the new sheet also
' has these events.

    Dim shT As Worksheet
    Dim sN As String
    
    'make copy of hidden template
    Application.ScreenUpdating = False
    With Sheets("NewShtTemplate")
        .Visible = xlSheetVisible
        .Copy after:=Sh
        Set shT = ActiveSheet
        .Visible = xlSheetHidden
    End With
    'get the name of the user created sheet and delete the sheet
    sN = Sh.Name
    Application.DisplayAlerts = False
    Sh.Delete
    Application.DisplayAlerts = True
    ' rename the copied template sheet with the new sheet name
    shT.Name = sN
    Application.ScreenUpdating = True
End Sub

Private Sub Workbook_Open()
    'run macro to hide warning sheet and unlock sheets
    Dim bB As Boolean
    Workbook_AfterSave b
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     'run macro to show warning sheet and lock sheets
   Dim shSh As Worksheet
    
    'store current sheet
    Set wsActive = ActiveSheet
    
    For Each shSh In Me.Sheets
        If shSh.ProtectContents = False Then
            shSh.Protect sWBPW
        End If
    Next shSh
    With Sheets("Warning")
        .Visible = xlSheetVisible
        .Activate
    End With
    
End Sub

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
     'run macro to hide warning sheet and unlock sheets
   Dim shSh As Worksheet
    Const sDontUnprotect As String = "Sheet1;Warning"   '<<< List sheets not to be unprotected separated by ;
    
    
    For Each shSh In Me.Sheets
        If Not "*;" & shSh.Name & ";*" Like sDontUnprotect Then
            shSh.Unprotect sWBPW
        End If
    Next shSh
    Sheets("Warning").Visible = xlSheetHidden
    
        'restore current sheet
    If Not wsActive Is Nothing Then wsActive.Activate

End Sub

 

[sijpie]

Read through the comments in the code above. Where the code starts with <<<< your input may be required