How do I Track Changes on Multi-Cell Targets?

M

MikeZz

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
 
J

JE McGimpsey

Target is just the selected range when the change is made, so to deal
with all selected cells (including multiple areas):

Dim rArea As Range
Dim rCell As Range
For Each rArea In Target.Areas
For Each rCell In rArea
'your individual cell code here
Next rCell
Next rArea

Of course, one can add a layer of complexity, too, if multiple
worksheets are selected:

Dim ws As Worksheet
Dim rArea As Range
Dim rCell As Range
For Each ws in ActiveWindow.SelectedSheets
For Each rArea in ws.Range(Target.Address).Areas
For Each rCell In rArea
'individual cell code
Next rCell
Next rArea
Next ws
 
R

Roger Whitehead

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 said:
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
Click to expand...
 
J

JE McGimpsey

Hmmm...

Select A1, C3, and E5. Enter a value in one of the cells. See which
"blah" gets executed...
 
R

Roger Whitehead

Yep, I didn't read properly - sorry...

Roger

JE McGimpsey said:
Hmmm...

Select A1, C3, and E5. Enter a value in one of the cells. See which
"blah" gets executed...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Track Events in Worbook in VBA .XLA Add-in 0
Log of users who open the workbook 0
Need help - track changes code needs tweaking 0
Worksheet_Change Woes 6
Get rid of need for F2.Select 3
Change_Event troubles, no error & no work. 6
Change_Event not responding to change made by formula. 11
Pass condition formatting across worksheets via vba. 0

Top