Posting again. Please Help! How to "track changes" using VBA

[Paolo De Laurentiis]

I'm trying to rewrite a sort of the "track changes" feature of Excel using
VBA.
The method I'm following is to store in a variable the value of the active
cell/range every time the application event "selection change" is triggered.
Then, we a change happens ("sheet change" event is triggered) I compare the
new value with the previously stored variable.

This works fine when the user changes cells using "normal" methods like just
writing into
a cell or copying and pasting.

However, it doesn't work when using the autofill method: dragging
(or double clicking) the small dot at bottom right corner of the selection
marker.
In this case the "change" event is triggered BEFORE the "selection change"
event, and not after as in "normal" methods.
So in this case the application cannot store the values/formulas the cells
had before they were changed, thus I can't compare changes.

That's the SheetChange event declaration I'm using. Maybe I'm missing
somthing?
Private Sub App_SheetChange(ByVal Sh As Object, ByVal Target As Range)

I wonder whether there's a complete different way for doing that, like
having a method of the range object that is passed to the "Sheet Change"
event
that stores the value/formula the range had before the change.

Do you have any idea for solving the above issue?
Many thanks for your help.

Paolo
Milan, Italy

 

[Bob Phillips]

Paolo,

I have no idea how you know whether it is triggered by an autofill or by a
multi-cell change, but one of the problems is probably that you Target is
multi-cell, so you need to loop through them one at a time in the event
code.

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Paolo De Laurentiis]

Bob,

actually I can track changes even for multi-cell changes (CTRL+ENTER to be
clear) or copy and paste operation on multi-cells ranges: I just loop
between the selection to store every value.

What I cannot track is when a drag a cell (from the right-bottom corner)
like when trying to extend a series of values.
In this case the order of the two events is inverted: 1) Sheetchange 2)
selection Change, while in normal condition is the opposite.
Paolo

 

[Tushar Mehta]

I cannot duplicate that problem -- at least not with XL2003. I tested
with both worksheet level events and application level events. I also
tested by dragging the bottom-right corner down a column as well as
double-clicking the same corner.

In all cases the _SelectionChange event occured before the _Change
event.

However -- and as expected -- it is possible to fake out the method you
use to track changes. Just use the Edit | Fill > Series... and only
the _Change event will be triggered. I tested with a linear series.

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[Peter T]

Tushar & Paolo,

I do duplicate the order of events as described by the Paolo. Namely, with
autofill (drag or double click the handle) the _Change event occurs before
the _SelectionChange (XL2k).

In addition to this problem and the "Edit | Fill > Series" issue there could
be other reasons for the method to fail to pick up all changes, eg change
the layout of the sheet (no events for insert/delete cells), change the
value of a cell second time (no _SelectionChange event if still same active
cell), and more. There are more reliable methods with downside of more code
& use of resources if a large used range.

Regards,
Peter T

 

[Paolo De Laurentiis]

Tushar, Peter,
thanks for replying.
For your info I'm using XL2000, so probably Microsoft updated that "bug"
with the 2003 release.

Peter,
to which methods are you referring to?
I also tried with an Undo/Repeat approach, but with not much success.

By the way, have a look to the thread "Another change event request" (Jan
26th) if you have time, since we are posting about the same topic.

Paolo

 

[Peter T]

to which methods are you referring to? [track changes]

By the way, have a look to the thread "Another change event request" (Jan
26th) if you have time, since we are posting about the same topic.

Paolo

I see in the other thread you want to trap changes on all sheets in all open
workbooks! Therefore I doubt you'll be interested in my "other methods",
unless each UsedRange is not too big.

FWIW as you asked, it means storing everything that you need to track, for
the period you need to track. What and for how long depends on needs. I did
say resources!

Eg:
-Want to track changes to existing number constants,
-Not interested in anything else, even newly added constants
-Want to replace or highlight changes at some point in the future,
-If cells have been "moved" (cut, dragged, inserted rows etc), ensure
replaced values go into correct cells.

Could store as arrays or into worksheets, advantages to each. Following is
into sheets in the code wb. Assumes code is in a dedicated workbook or
addin. All in a normal module although normally would be linked to events,
with variables passed around etc.

Put a mixture of stuff in active workbook. Run CopySheet. Change existing
constant values. Drag, cut, insert/delete rows, autofill, give it a hard
time. Run ChangedCells, try first time with bUndo = false.

'''''''''''''''''''''''''''''
Option Explicit
Dim wsSource As Worksheet
Dim wsVal As Worksheet 'copy of data from source sheet
Dim wsIf As Worksheet 'If formulas to compare changed cells

Sub CopySheet()
Dim rng As Range, ar As Range
Dim sF As String, sFa As String
' Ensure sheets 2 & 3 in ThisWorkbook are available
If ActiveWorkbook Is ThisWorkbook Then
MsgBox "In this demo ActiveWorkbook" & vbCr & _
"should not be ThisWorkbook"
Exit Sub
End If

Set wsSource = ActiveWorkbook.ActiveSheet
Set wsVal = ThisWorkbook.Worksheets(2)
Set wsIf = ThisWorkbook.Worksheets(3)


On Error Resume Next
'Due to 8000 areas limit of SpecialCells,
'might need to do in max chunks of 16000 cells.
'Error if no specialcells
Set rng = wsSource.Cells(1).SpecialCells(xlCellTypeConstants, 1)
On Error GoTo errH

wsVal.UsedRange.Clear
wsIf.UsedRange.Clear

If Not rng Is Nothing Then

'maybe trap/replace settings
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

sFa = "=If('[" & wsSource.Parent.Name & "]" & wsSource.Name & "'!"

For Each ar In rng.Areas
sF = sFa & ar(1).Address(0, 0) & "="
sF = sF & wsVal.Name & "!" & ar(1).Address(0, 0) & ","""",1)"

wsVal.Range(ar.Address) = ar.Value

With wsIf
.Range(ar(1).Address).Formula = sF
If ar.Rows.Count > 1 Then
.Range(ar(1).Address).AutoFill .Range(ar.Address).Columns(1)
End If
If ar.Columns.Count > 1 Then
.Range(ar.Address).Columns(1).AutoFill .Range(ar.Address)
End If
End With
Next
'perhaps a worksheet formula to count "If false" cells
End If

errH:
'don't need to restore app settings if "rng is Nothing"
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub ChangedCells()
Dim bUndo As Boolean, bFill As Boolean
Dim vChanges
bUndo = True
bFill = True
vChanges = DoChanges(bUndo, bFill)
MsgBox "Changed cells: " & vChanges
End Sub

Function DoChanges(bRestore As Boolean, bHighlight As Boolean)
Dim rng As Range, cell As Range, sAddr As String, sF As String
Dim pos As Long, nLen As Long, nCx As Long

If wsIf Is Nothing Then
DoChanges = "Mod Sht variables Nothing"
Exit Function
End If

On Error Resume Next
Set rng = wsIf.Cells(1).SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo errH

If Not rng Is Nothing Then
nCx = IIf(bRestore And bHighlight, 15, 40)

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

For Each cell In rng
sF = cell.Formula
pos = InStr(cell.Formula, "!") + 1
nLen = InStr(pos, cell.Formula, "=") - pos
sAddr = Mid(cell.Formula, pos, nLen)

With wsSource.Range(sAddr)
If bHighlight Then
.Interior.ColorIndex = nCx
End If
If bRestore Then
.Value = wsVal.Range(cell.Address)
End If
End With
Next
DoChanges = rng.Count
Else: DoChanges = 0
End If
errH:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

If Err.Number Then
DoChanges = "Error #" & Err.Number
' Stop 'for debugging
' Resume
End If
End Function
''''''''''''''''''''''''

Values are not replaced in "removed" cells but a lot of info about these is
available in the "If" cells. SpecialCells > error cells, #REF, etc. Could do
more in this respect.

Note - if any of the "If" cells change value a calculation event is
triggered in the parent workbook (might be useful where change events are
not triggered).

Not sure if it's viable to combine with a worksheet activate event, havn't
tried but maybe?

Briefly about events, I see a lot has been discussed in the "other thread"
but one more thing. As you know can trap "With Events" at application level,
workbook or sheet level. One advantage to either of the latter is can build
up an array or collection of "With Events", then variables can be assigned
uniquely to their respective class's (in same class module). Variables in
"others" are available if required with a prefixed reference.

Regards,
Peter T