Tracking workbook changes on new sheet using a macro help

[A Antury]

Hi,

I've been using a code that I found to create a record of changes produced in a workbook using a new 'tracker' sheet within the workbook. The code works well, the headers of the tracker are like this:

cell Changed | Old Value | New Value | Old Formula | New Formula | Time of Change| Date of Change | User


My problem is that I now need to list the values from columns A, B and AC automatically from the original sheet whenever a cell has been modified (so the rows can be identified) on the 'tracker' sheet. I would be grateful if anyone could help me adding three columns to the 'tracker' tab so the headers are:

Cell Changed | Old Value | New Value | Old Formula | New Formula| Time of Change | Date of Change| User | (Value from col A) | (Value from col B) | (Value from col AC)



The code I'm using is this one:

 
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

Many thanks