problems with audit trail

[scotthannaford1973]

Hi all

I have the code below which should record changes to cells in a worksheet - recording cell, old value, new value, time, date and domain name of person that made changes. It works well, except:

1. the old value is never recorded and just shows a blank. how do I record the old value (maybe the value when the workbook was opened?)
2. the code only works when individual cells are updated, so if a range is updated, it's not recorded. Is it possible to record changes to an unnamed range of cells, or just individual cells?

thanks in advance

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "SCHEMES" Then
        Dim bBold As Boolean
        Dim vOldVal As String
        If Target.Cells.Count > 1 Then Exit Sub
        'On Error Resume Next
        With Application
             .ScreenUpdating = False
             .EnableEvents = False
        End With
        If IsEmpty(vOldVal) Then vOldVal = "Broken"
        bBold = Target.HasFormula
            With Sheets("AUDIT TRAIL")
                '.Unprotect Password:="Secret"
                    If .Range("A1") = vbNullString Then
                        .Range("A1:e1") = Array("Sheet/Cell", "Old Value (not working)", "New Value", "Time", "Date", "User")
                    End If
                With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                    .Value = ActiveSheet.Name & " : " & Target.Address
                    .Offset(0, 1) = vOldVal
                    With .Offset(0, 2)
                        If bBold = True Then
                            .ClearComments
                            .AddComment.Text Text:="Scott Says:" & Chr(10) & "" & Chr(10) & "Bold values are the results of formulas"
                        End If
                        .Value = Target
                        .Font.Bold = bBold
                    End With
                    .Offset(0, 3) = Time
                    .Offset(0, 4) = Date
                    .Offset(0, 5) = Application.UserName
                End With
                .Cells.Columns.AutoFit
                '.Protect Password:="TrackerL2019"
            End With
        vOldVal = vbNullString
        With Application
             .ScreenUpdating = True
             .EnableEvents = True
        End With
        'On Error GoTo 0
    End If
End Sub

 

[RoryA]

Since you're monitoring every cell, the most practical option is probably to store the new value, use Application.Undo to restore the old value so that you can read it, and then put the new value back.

 

[DanteAmor]

1. the old value is never recorded and just shows a blank. how do I record the old value (maybe the value when the workbook was opened?)
2. the code only works when individual cells are updated, so if a range is updated, it's not recorded. Is it possible to record changes to an unnamed range of cells, or just individual cells?

I put the updated code.
1. To save the previous value, taking RoryA's suggestion.
2. I also added the part so you can modify several cells at once. But you must be cautious, I put it in the value 100, with a larger number maybe I can collapse the excel.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Sh.Name = "SCHEMES" Then
    Dim bBold As Boolean, vOldVal As Variant
    Dim [COLOR=#008000]dato[/COLOR], [COLOR=#0000ff]c As Range[/COLOR]
    If Target.Cells.Count > [COLOR=#ff0000]100[/COLOR] Then Exit Sub
    On Error GoTo AppEnaEve
    With Application
      .ScreenUpdating = False
      .EnableEvents = False
[COLOR=#008000]      dato = Target.Value[/COLOR]
[COLOR=#008000]      .Undo[/COLOR]
    End With
    '
[COLOR=#0000ff]    For Each c In Target[/COLOR]
[COLOR=#008000]      vOldVal = c.Value[/COLOR]
      bBold = Target.HasFormula
      With Sheets("AUDIT TRAIL")
        '.Unprotect Password:="Secret"
        If .Range("A1") = vbNullString Then
          .Range("A1:e1") = Array("Sheet/Cell", "Old Value (not working)", "New Value", "Time", "Date", "User")
        End If
        With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
          .Value = ActiveSheet.Name & " : " & [COLOR=#0000ff]c.Address[/COLOR]
          .Offset(0, 1) = [COLOR=#008000]c.Value[/COLOR]
          With .Offset(0, 2)
            If bBold = True Then
              .ClearComments
              .AddComment.Text Text:="Scott Says:" & Chr(10) & "" & Chr(10) & "Bold values are the results of formulas"
            End If
            .Value = Target
            .Font.Bold = bBold
          End With
          .Offset(0, 3) = Time
          .Offset(0, 4) = Date
          .Offset(0, 5) = Application.UserName
        End With
        .Cells.Columns.AutoFit
        '.Protect Password:="TrackerL2019"
      End With
[COLOR=#008000]      c.Value = vOldVal[/COLOR]
    Next
[COLOR=#008000]    Target.Value = dato[/COLOR]
    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
  End If
AppEnaEve:
  Application.EnableEvents = True
End Sub