Excel

Track Changes - Text and Formulas with user name and time stamp

Ease of Use

Intermediate

Version tested with

2003 

Submitted by:

arkusM

Description:

This Macro would be used to track all _changes_ to a sheet, whether they are data entry changes or formula changes. and displays the old value in a seperate sheet. 

Discussion:

I developed by modifying lenze's change macro (http://vbaexpress.com/kb/getarticle.php?kb_id=909). This version will track changes in a new sheet, I created this code for a Excel application that I created and maintained but did not use. It was intended it to be a history maker for the file. **NB** this macro renders the "undo" function useless. **NB** this maco will not show data cahnges when multiple cells are selected. It will show the range that cahnged but does not show each cell change. There is password protection in the code but it is commented out. CODE: '.Protect Password:="Secret" Modification ideas: - Track change on a new, hidden, file. 

Code:

instructions for use

			

Option Explicit Dim sOldAddress As String Dim vOldValue As Variant Dim sOldFormula As String Private Sub Workbook_TrackChange(Cancel As Boolean) Dim sh As Worksheet For Each sh In ActiveWorkbook.Worksheets sh.PageSetup.LeftFooter = "&06" & ActiveWorkbook.FullName & vbLf & "&A" Next sh End Sub Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range) ''''''''''''''''''''''''''''''''''''''''''''' 'Thanks to lenze for getting me started on this project (http://vbaexpress.com/kb/getarticle.php?kb_id=909) 'http://www.mrexcel.com/forum/showthread.php?t=376400&referrerid=76744 'Thanks to Colin_L 'Adapted by Mark Reierson 2009 ''''''''''''''''''''''''''''''''''''''''''''' Dim wSheet As Worksheet Dim wActSheet As Worksheet Dim iCol As Integer Set wActSheet = ActiveSheet 'Precursor Exits 'Other conditions that you do not want to tracke could be added here If vOldValue = "" Then Exit Sub 'If you comment out this line *every* entry will be recorded 'Continue On Error Resume Next ' This Error-Resume-Next is only to allow the creation of the tracker sheet. Set wSheet = Sheets("Tracker") '**** Add the tracker Sheet if it does not exist **** If wSheet Is Nothing Then Set wActSheet = ActiveSheet Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tracker" 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("Tracker") '******** 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 *****************************************************************************' .Unprotect Password:="Secret" '******** 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" 'Uncomment to protect the "tracker tab" 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 If .HasFormula Then sOldFormula = "'" & Target.Formula Else sOldFormula = vbNullString End If End If End With End Sub

How to use:

  1. The code should be copied in its entirety into the "thisWorkbook" code sheet.
  2. When a value is entered then changed the macro should fire.
  3. Close the Code window and exit the Editor.
 

Test the code:

  1. Enter data on any sheet. Change the value, a new tab should be created called "Tracker", navigate to this tab and you should see the old and new values your user name and time you made the change.
  2. Test on single cell entries and test on multiple cells to see if this will work for you.
 

Sample File:

Track changes Macro.zip 11.8KB 

Approved by Jacob Hilderbrand


This entry has been viewed 606 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express