Workbook change tracking not working as expected.

[billfinn]

Good morning,
I am trying to track changes to a workbook in a worksheet named Audit
I found a macro on this site and gave it a try but no changes are showing up in the audit worksheet.
I inserted the macro in the workbook. I made multiple changes to the Quick Quote sheet and saved the workbook, reopened it and there were no entries in the Audit worksheet

Not sure where I went wrong but any suggestions are appreciated.
Thanks much,
Bill

Option Explicit
Dim sOldAddress As String
Dim vOldValue As Variant
Dim sOldFormula As String


'
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim wSheet As Worksheet
    Dim wActSheet As Worksheet
    Dim iCol As Integer
    Set wActSheet = ActiveSheet
   
    On Error Resume Next    ' This Error resume next is only to allow the creation of the tracker sheet.
    Set wSheet = Sheets("Audit")
    '**** Add the tracker Sheet if it does not exist ****
    If wSheet Is Nothing Then
        Set wActSheet = ActiveSheet
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Audit"
    End If
    On Error GoTo 0
    '**** End of specific error resume next
    On Error GoTo ErrorHandler
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    With Sheets("Audit")
        '******** This bit of code moves the tracker over a column when the first columns are full**'
        If .Cells(1, 1) = "" Then                                                               '
            iCol = 1                                                                            '
        Else                                                                                    '
            iCol = .Cells(1, 256).End(xlToLeft).Column - 7                                      '
            If Not .Cells(65536, iCol) = "" Then                                                '
                iCol = .Cells(1, 256).End(xlToLeft).Column + 1                                  '
            End If                                                                              '
        End If                                                                                  '
        '********* END *****************************************************************************
        '******** Sets the Column Headers **********************************************************
        If LenB(.Cells(1, iCol).Value) = 0 Then
            .Range(.Cells(1, iCol), .Cells(1, iCol + 7)) = Array("Cell Changed", "Old Value", _
                                                                 "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
            .Cells.Columns.AutoFit
        End If
        With .Cells(.Rows.Count, iCol).End(xlUp).Offset(1)
            .Value = sOldAddress
            .Offset(0, 1).Value = vOldValue
            .Offset(0, 3).Value = sOldFormula
            If Target.Count = 1 Then
                .Offset(0, 2).Value = Target.Value
                If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula
            End If
            .Offset(0, 5) = Time
            .Offset(0, 6) = Date
            .Offset(0, 7) = Application.UserName
            .Offset(0, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
        End With
        '.Protect Password:="Secret"
    End With
ErrorExit:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    wActSheet.Activate
    Exit Sub
ErrorHandler:
    'any error handling you want
    'Debug.Print "We have an error"
    Resume ErrorExit
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
    With Target
        sOldAddress = .Address(external:=True)
        If .Count > 1 Then
            vOldValue = "Multiple Cell Select"
            sOldFormula = vbNullString
        Else
            vOldValue = .Value
            sOldFormula = Cells(.Row(), 9)
            ' If .HasFormula Then
            '     sOldFormula = "'" & Target.Formula
            ' Else
            '     sOldFormula = vbNullString
            ' End If
        End If
    End With
End Sub

 

[dmt32]

Hi,
have you placed the code in the Thisworkbook code page of your workbook?

Dave

 

[billfinn]

Hi Dave,
Yes, that was the first thing I tried. Once I placed in each sheet it worked fine.
Thanks much for the response.
Bill