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)
Dim wSheet As Worksheet
Dim wActSheet As Worksheet
Dim iCol As Integer
Set wActSheet = ActiveSheet
If vOldValue = "" Then Exit Sub
On Error Resume Next
Set wSheet = Sheets("Tracker")
If wSheet Is Nothing Then
Set wActSheet = ActiveSheet
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Tracker"
End If
On Error GoTo 0
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With Sheets("Tracker")
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
.Unprotect Password:="Secret"
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
End With
ErrorExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
wActSheet.Activate
Exit Sub
ErrorHandler:
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
|