VBA code to track changes in workbook

[Fwiz]

hi,

I have a specific range within my worksheet ie d9:v20

when any of these cells within this range are changed - ie changed being defined as changed the content of the cell and saved the workbook.

if the content of cells are changed then I'd like my code to write up the event in a separate worksheet (in same workbook) showing name, date of change and what the cell was changed to and from.

is this possible?



thanks

 

[xtreme247]

I don't think you can capture the old value.
You can in Access because there's a BeforeUpdate event, and controls have an OldValue property. In Access, the Change event only fires once the change is made, and the old value is lost.
I'm happy to be proved wrong on this, but I think you might be out of luck.

Denis

Thanks for your feedback Denis. Is there some sort of code that could grab the old value and get it in the log sheet before it is changed, or 2) grab the new value get it in the log undo it, thus getting the old value, and then place it in the log? This is beyond my level of vb. Thanks.

 

[Geniusduffer]

Thanks for your feedback Denis. Is there some sort of code that could grab the old value and get it in the log sheet before it is changed, or 2) grab the new value get it in the log undo it, thus getting the old value, and then place it in the log? This is beyond my level of vb. Thanks.

Hi,
I am not a VB person but have learned from much experienced and helpful people here, anyways I took a help from the codes posted by Ruddles (thanks) and have tried following, which hopefully should help:

Option Explicit 
Const LiveWS As String = "Sheet1"
Const AuditWS As String = "Audit"
 
Private Sub Workbook_Open()
 
  Dim iRow As Integer
  Dim iCol As Integer
  Dim iLastRow As Long, msgRow As Long
  Dim msg As String
    
  If Sheets(AuditWS).Cells(2, 1) = "" Or Sheets(AuditWS).Cells(2, 2) = "" Or Sheets(AuditWS).Cells(2, 2) = "" Then
  Sheets(AuditWS).Cells(2, 1) = Environ("USERNAME")
  Sheets(AuditWS).Cells(2, 2) = Format(Now(), "dd/mm/yyyy")
  Sheets(AuditWS).Cells(2, 3) = Format(Now(), "hh:mm:ss")
  End If
 
'Default msg if no changes are made
    msg = "Workbook was opened by " & Sheets(AuditWS).Cells(2, 1) _
    & " on " & Sheets(AuditWS).Cells(2, 2) & " at " & Format((Sheets(AuditWS).Cells(2, 3)), "hh:mm:ss") _
    & ", they did not save any changes"
    
'Reserve row for main message to be displayed
msgRow = Sheets(AuditWS).Cells(Rows.Count, 1).End(xlUp).Row
iLastRow = msgRow + 1


'Detect and record if changes were made
    For iRow = 1 To 400
    For iCol = 1 To 200
      If Sheets(AuditWS).Cells(iRow, iCol + 10).Value <> Sheets(LiveWS).Cells(iRow, iCol).Value Then
        'change msg if changes are detected
           msg = "Workbook was opened by " & Sheets(AuditWS).Cells(2, 1) _
                & " on " & Sheets(AuditWS).Cells(2, 2) & " at " & Format((Sheets(AuditWS).Cells(2, 3)), "hh:mm:ss") _
                & ", they made following changes:"
        
            Sheets(AuditWS).Cells(iLastRow + 1, 1) = AlphaCol(iCol) & CStr(iRow)
            Sheets(AuditWS).Cells(iLastRow + 1, 2) = Sheets(AuditWS).Cells(iRow, iCol + 10).Value
            Sheets(AuditWS).Cells(iLastRow + 1, 3) = Sheets(LiveWS).Cells(iRow, iCol).Value
            'Update last row after above entries
            iLastRow = Sheets(AuditWS).Cells(Rows.Count, 1).End(xlUp).Row
'update the comaprsion records in audit sheet
            Sheets(AuditWS).Cells(iRow, iCol + 10) = Sheets(LiveWS).Cells(iRow, iCol).Value


        End If
    Next iCol
    Next iRow


  Sheets(AuditWS).Cells(msgRow + 1, 1) = msg
  
  'Record current user's data for next record entry
  Sheets(AuditWS).Cells(2, 1) = Environ("USERNAME")
  Sheets(AuditWS).Cells(2, 2) = Format(Now(), "dd/mm/yyyy")
  Sheets(AuditWS).Cells(2, 3) = Format(Now(), "hh:mm:ss")
  


  ActiveWorkbook.Save
 
End Sub
Public Function AlphaCol(argColumn As Integer) As String
 
  Dim intPrefix As Integer
  Dim strPrefix As String
 
  intPrefix = 0
  Do Until argColumn <= 26
    intPrefix = intPrefix + 1
    argColumn = argColumn - 26
  Loop


  If intPrefix > 0 Then strPrefix = Chr(intPrefix + 64)
 
  AlphaCol = strPrefix & Chr(argColumn + 64)
  
End Function

 

[edwardfraser]

Hi Ruddles , I just tried your original code posted to fiz some time ago.

It works by replicating all the data on on the target sheet in the audit sheet . How can I get it to flag up just the changes though? I have opened and closed the workbook several times.

my workbook consist of two worksheets sheet1 and audit

 

[stacey52891]

Post # 2 from SidneyGeek code works well for me, but how do you track the author that made the changes? How can I add this into the code?

 

[redous]

Hi,

Not sure if anyone can use this but it works for my needs.

Place the below in a module

'Log Stuff Function
Public Function LogChange(Optional Message)
    Dim StartTime As Double
    Dim TempArray() As Variant
    Dim TheRange As Range
    
    Application.ScreenUpdating = False
    
    ' How Long Does This Take to Run?
    ' StartTime = Timer
    ' Redimension temporary array
    ReDim TempArray(0, 5)
    ' Which row is this going in?
    Lastrow = Sheets("Log").UsedRange.Rows.Count + 1
        
    ' Set the destination range
    FirstCell = "A" & Lastrow
    LastCell = "F" & Lastrow
    'Store the tracked data in an array
    TempArray(0, 0) = FormatDateTime(Now, vbShortDate)
    TempArray(0, 1) = FormatDateTime(Now, vbLongTime)
    TempArray(0, 2) = Environ$("username")
    TempArray(0, 3) = Environ$("computername")
    TempArray(0, 4) = ActiveSheet.Name
    TempArray(0, 5) = Message
    ' Transfer temporary array to worksheet
    Set TheRange = Sheets("Log").Range(FirstCell, LastCell)
    TheRange.Value = TempArray
    ' Display elapsed time
    'MsgBox Format(Timer - StartTime, "00.00") & " seconds"
    Application.ScreenUpdating = True
End Function

Then in ThisWorkbook use the following macros to log required data I have


Any changes in the workbook unless you filter out what you dont want

Note: you have to leave the below in the code otherwise you will create a circular reference.

 If Sh.Name = "Log" Then Exit Sub

Dim PreviousValue As String ' For Logging
Dim CurrentValue As String  ' For Logging

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    CurrentValue = "" ' Reset the current value    If Sh.Name = "Report" Then Exit Sub
    If Sh.Name = "Calculations" Then Exit Sub
    If Sh.Name = "Calendar" Then Exit Sub
    If Sh.Name = "Log" Then Exit Sub
    If Sh.Name = "Cross Training" Then Exit Sub
    On Error Resume Next
    If Err.Number = 13 Then
        PreviousValue = 0
    Else
        CurrentValue = Target.Value
    End If
    On Error GoTo 0
    ' If there is no values, don't run the following. This fixed a custom macro to add 10 formatted blank lines in a detail sheet
    If PreviousValue = "" And CurrentValue = "" Then Exit Sub
    If VarType(PreviousValue) = VarType(CurrentValue) Then
        If CurrentValue <> PreviousValue Then
            If Err.Number = 13 Then
               PreviousValue = 0
            End If
            If PreviousValue = "" Then
                PreviousValue = "EMPTY"
            End If
            If CurrentValue = "" Then
                CurrentValue = "EMPTY"
            End If
            LogChange (Target.Address & " changed from " & PreviousValue & " to " & CurrentValue)
          End If
    End If
    PreviousValue = 0
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Err.Number = 7 Then Exit Sub
    
    'Capture the What used to be in the changed cell
    PreviousValue = Target.Value
End Sub

Other functions to push through the Log Sheet can be used as well

Log when a user creates a new worksheet

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    LogChange ("New Sheet Created")
End Sub

Log when a user saves the document

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    LogChange ("Saved " & ActiveWorkbook.Name)
End Sub

 

[redous]

Oh 1 more things to mention I am not the author of the code I am merely someone who has adapted a piece of code to fit my needs.

 

[ssu02193]

As I said.

And if it's deficient in any way, I'm happy to look at changing the code to suit your requirements.

Hi Ruddles! Are you still out there? I've adapted your brilliant code to save changes in a new sheet in the same workbook and it works like a charm. Thank you so much!

But then I got fancy and wanted to identify the cell address the change came from in addition to the change. Haha, my limited vba skills stop me cold.

This code shows what I tried, but right after the "Else" line, my Set Ralph gets an error: Application-defined or object-defined error.

Other than that, it does just what I'm after. Here's the code. Thanks for any help!


Sub test()


Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Dim Output As Range
Set Output = ActiveWorkbook.Worksheets("Sheet4").Range("a1")
Dim Ralph As Variant



strRangeToCheck = "A1:z150"
' If you know the data will only be in a smaller range, reduce the size of the ranges above.
Debug.Print Now
varSheetA = Worksheets("Sheet1").Range(strRangeToCheck)
varSheetB = Worksheets("Sheet2").Range(strRangeToCheck) ' or whatever your other sheet is.
Debug.Print Now


For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
' Cells are identical.
' Do nothing.
Else
' Cells are different.
' Code goes here for whatever it is you want to do.
Set Ralph = Worksheets("Sheet1").Range(Cells(varSheetA(iRow, iCol)))

Output.Value = _
Ralph & "Sheet A is " & varSheetA(iRow, iCol) & " . And Sheet B is " & varSheetB(iRow, iCol)




Set Output = Output.Offset(1, 0)
End If
Next iCol
Next iRow


End Sub