VBA code to Track changes in a workbook

[Veenu90]

Hi,

I am working on a shared file which is being updated by multiple users. I am not able to track who changes what. Can we have a "Update Log" sheet which captures the following details -

1. Date & Time
2. Modified by which User
3. Sheet Name that was updated
4. Cell Reference
4. Old value
5. New value

so if any changes made in any cell that can be captured here.

Thanks in advance!

 

[Nutster]

Take a look on the Review tab of the Ribbon. In the Changes section is Track Changes. If this will not do for your situation, why not?

 

[Logit]

.
Paste the following in ThisWorkbook module :

Option Explicit


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
If ActiveSheet.Name = "Pricing" 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 Sheets("Tracker")
            '.Unprotect Password:="Secret"
                If .Range("A1") = vbNullString Then
                    .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "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:= _
                     "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
                .Offset(0, 5) = Application.UserName
            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


Private Sub test()
    Application.EnableEvents = True
End Sub