View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Roger Whitehead[_2_] Roger Whitehead[_2_] is offline
external usenet poster
 
Posts: 28
Default How do I Track Changes on Multi-Cell Targets?

Have you tried:
If(IsArray(Target))
'blah
else
'blah
end if

In the worksheet_change or worksheet_selectionchange events?


--
HTH
Roger
Shaftesbury (UK)
(Excel 2003, Win XP/SP2)

"MikeZz" wrote in message
...
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 he
'http://www.ozgrid.com/VBA/track-changes.htm
'

If SheetVeryHidden.Range("ActivaterChangeTracking").V alue < 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