In my case, I can't use Share Workbook/Track changes so I created my own
macro to track change history per
www.ozgrid.com/VBA/track-changes.htm and
other sources.
The problem is that I can't find anything that will help me track when
multiple cells are the "Target". A good example is if someone grabs a range
of 10 cells and hit's "Delete". My code only looks at single cell targets.
Excel's change-tracking allows that functionality but can't find any place
that explains how to do it.
Thanks!
MikeZz
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bBold As Boolean
Dim thisHead
Dim rngHist
'
'Code taken from here:
'http://www.ozgrid.com/VBA/track-changes.htm
'
If SheetVeryHidden.Range("ActivaterChangeTracking").Value <> True Then
Exit Sub
End If
cellcolGUID = Range("GUID").Column
cellcolToday = Range("colToday").Column
cellcolHist = Range("colHistory").Column
cellcolSQ = Range("colCellSQ").Column
If Target.Cells.Count > 1 Or Target.Column >= cellcolSQ Then Exit Sub
On Error Resume Next
If vOldVal = Target Then Exit Sub
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
changeCount = changeCount + 1
arrChanges(changeCount, colAdd) = Target.Address
'HeadingRow
thisHead = Cells(HeadingRow, Target.Column)
arrChanges(changeCount, colHed) = thisHead
arrChanges(changeCount, colGUID) = Cells(Target.Row, cellcolGUID)
Set rngHist = Cells(Target.Row, cellcolHist)
editTime = Format(Now(), "mmm dd h:m:s") & "] "
rngHist.Value = "[" & strUserInit & "! " & editTime & thisHead & ": " &
vOldVal & " >> " & Target & Chr(10) & rngHist.Value
Set rngHist = Nothing
arrChanges(changeCount, colOld) = vOldVal
If bBold = True Then
arrChanges(changeCount, colNew) = "'" & Target.Formula & "=" & Target
Else
arrChanges(changeCount, colNew) = Target
End If
arrChanges(changeCount, colTim) = Time
arrChanges(changeCount, colDat) = Date
arrChanges(changeCount, colUsr) = strUser
GoTo skipWith
With Changes
' .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
.Offset(0, 5) = strUser
End With
.Cells.Columns.AutoFit
' .Protect Password:="Secret"
End With
skipWith:
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.HasFormula = True Then
vOldVal = "'" & Target.Formula & "=" & Target
Else
vOldVal = Target
End If
End Sub
Similar Threads
