Track/Report User Changes on an Excel Worksheet/Workbook

Excel VBA: Track & Report User Changes on an Excel Worksheet or Workbook

Got any Excel/VBA Questions? Excel Help

Track/Report User Changes on an Excel Worksheet/Workbook

As some Excel users are aware, Excel has a feature called Track Changes, found under Tools on the Worksheet Menu Bar. However, when this is chosen you are forced to share the Workbook. With this feature enabled, there are many standard Excel features that are no longer available. See "Features that are unavailable in shared workbooks" in the Excel help for details.

To overcome this issue we can employ some help from Excel VBA and makes use of Excel's Change Events. Just be aware this code is only designed to track and record user changes to one cell at a time. Also, the code 'as is' assumes you have a Worksheet in the Workbook with a sheet code name of Sheet1. This Worksheet should also be xlVeryHidden so other users are not able to modify the report. While there is Worksheet protection applied to Sheet1, Excel's Worksheet protection is rather weak so the hiding of the sheet is an added measure. Especially when we lock the visual basic editor.

Track/Report User Changes on 1 Particular Worksheet.

The code below must be placed in the Private Module of the Worksheet you would like changes tracked and logged. To easily get there right click on the sheet name tab and choose View Code. In here paste the code below;

Dim vOldVal 'Must be at top of module

Private Sub Worksheet_Change(ByVal Target As Range)

Dim bBold As Boolean



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 = "Empty Cell"

    bBold = Target.HasFormula

        With Sheet1

            .Unprotect Password:="Secret"

                If .Range("A1") = vbNullString Then

                    .Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _
                        "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")

                End If





            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)

                  .Value = Target.Address

                  .Offset(0, 1) = vOldVal

                      With .Offset(0, 2)

                        If bBold = True Then

                          .ClearComments

                          .AddComment.Text Text:= _

                               "OzGrid.com:" & 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

            End With

            .Cells.Columns.AutoFit

            .Protect Password:="Secret"

        End With

    vOldVal = vbNullString



    With Application

         .ScreenUpdating = True

         .EnableEvents = True

    End With



On Error GoTo 0

End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    vOldVal = Target

End Sub

Track/Report User Changes on all Worksheets in 1 Workbook

The code below must be placed in the Private Module of the Workbook (ThisWorkbook) you would like changes tracked and logged. To easily get there right click on the excel icon, top left next to File and choose View Code. In here paste the code below;

Dim vOldVal 'Must be at top of module



Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim bBold As Boolean



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 = "Empty Cell"

    bBold = Target.HasFormula

        With Sheet1

            .Unprotect Password:="Secret"

                If .Range("A1") = vbNullString Then

                    .Range("A1:E1") = Array("CELL CHANGED", "OLD VALUE", _
                        "NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE")

                End If

                

          

            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)

                  .Value = Target.Address

                  .Offset(0, 1) = vOldVal

                      With .Offset(0, 2)

                        If bBold = True Then

                          .ClearComments

                          .AddComment.Text Text:= _

                               "OzGrid.com:" & 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

            End With

            .Cells.Columns.AutoFit

            .Protect Password:="Secret"

        End With

    vOldVal = vbNullString



    With Application

         .ScreenUpdating = True

         .EnableEvents = True

    End With



On Error GoTo 0



End Sub



Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    vOldVal = Target

End Sub