Home > Net >  Excel Worksheet.Change event not capturing all changes
Excel Worksheet.Change event not capturing all changes

Time:10-17

When doing: right click -> Delete... -> Shift cells up|left on a selection of cells. The Target range passed to Worksheet.Change only reflects the selection, and not also the cells that got shifted up or left.

An illustration of the problem (apologies, I cannot upload images from this computer):

Say I have the following cells in my worksheet:

# A B C D
1 1 1 1 1
2 2 2 2 2
3 3 3 3 3

If I was to select the range B1:C1 and do: right click -> Delete... -> Shift cells up

The worksheet would now look like this: |#|A|B|C|D| |-:|:-:|:-:|:-:|:-:| |1|1|2|2|1| |2|2|3|3|2| |3|3| | |3|

According to the Worksheet.Change event:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Debug.Print Target.Address
End Sub

the cells that have changed are $B$1:$C$1 (the original selection).

However, it is clear that cells $B$1:$C$3 have changed (technically, all the cells in columns B and C may have changed but I'm not interested in that).

Is there a clean and efficient way to detect the minimal range of cells that have changed?

I have made several attempts that do stuff like track the used range on selection change, and compare the previous used range with the "convex hull" of the current used range and Target. But they are all either very slow or don't handle some edge cases.

CodePudding user response:

The Worksheet.Change event is very specific about what triggers it: it fires whenever a cell's formula/value is changed. When you delete cells and shift up, the cells underneath don't change, but their Address does - provable with a few lines in the immediate toolwindow:

set x = [A2]
[A1].delete xlshiftup
?x.address
$A$1

Since nothing in the Excel object model is tracking address changes, you're on your own here.

The challenge here is that Range("B1") will always return a brand new object pointer, so you can't use the Is operator to compare object references; Range("B1") Is Range("B1") will always be False:

?objptr([B1]),objptr([B1]),objptr([B1])
 2251121322704               2251121308592               2251121315312 
 2251121313296               2251121308592               2251121310608 
 2251121315312               2251121322704               2251121308592 

The pointer addresses do recur, but they're not reliable and there's no guarantee that another cell won't take that spot on another call - in fact it seems likely, since I got a collision on the first attempt:

?objptr([B2])
 2251121322704 

So we need a little data structure to help us out here - let's add a new TrackedCell class module where we can store the address independently from the Range reference, on the same object.

The catch is that we're deleting cells, so the encapsulated Range reference will throw error 424 "object required" if we try to access it - but that's useful information we can put to good use:

Private mOriginalAddress As String
Private mCell As Range

Public Property Get CurrentAddress() As String
    On Error Resume Next
    CurrentAddress = mCell.Address()
    If Err.Number <> 0 Then
        Debug.Print "Cell " & mOriginalAddress & " object reference is no longer valid"
        Set mCell = Nothing '<~ that pointer is useless now, but IsNothing is useful information
    End If
    On Error GoTo 0
End Property

Public Property Get HasMoved() As Boolean
    HasMoved = CurrentAddress <> mOriginalAddress And Not mCell Is Nothing
End Property

Public Property Get Cell() As Range
    Set Cell = mCell
End Property

Public Property Set Cell(ByVal RHS As Range)
    Set mCell = RHS
End Property

Public Property Get OriginalAddress() As String
    OriginalAddress = mOriginalAddress
End Property

Public Property Let OriginalAddress(ByVal RHS As String)
    mOriginalAddress = RHS
End Property

Back in the Worksheet module, we need a way to grab these cell references now. Worksheet.Activate could work, but Worksheet.SelectionChange should be tighter:

Option Explicit
Private Const TrackedRange As String = "B1:C42" '<~ specify the tracked range here
Private TrackedCells As New VBA.Collection '<~ As New will never be Nothing

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Set TrackedCells = New VBA.Collection '<~ wipe whatever we already got
    
    Dim Cell As Range
    For Each Cell In Me.Range(TrackedRange)
        
        Dim TrackedCell As TrackedCell
        Set TrackedCell = New TrackedCell
        
        Set TrackedCell.Cell = Cell
        TrackedCell.OriginalAddress = Cell.Address
        
        TrackedCells.Add TrackedCell
    
    Next
    
End Sub

So now we know where the tracked cells are, we're ready to handle Worksheet.Change:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Debug.Print "Range " & Target.Address & " was modified"
    
    Dim TrackedCell As TrackedCell
    For Each TrackedCell In TrackedCells
        
        If TrackedCell.HasMoved Then
            Debug.Print "Cell " & TrackedCell.OriginalAddress & " has moved to " & TrackedCell.CurrentAddress
        End If
    
    Next

End Sub

To test this you need to pick any cell on the sheet first (to run the SelectionChange handler), and then you can try deleting a cell in the immediate toolwindow:

[b3].delete xlshiftup
Range $B$3 was modified
Cell $B$3 object reference is no longer valid
Cell $B$4 has moved to $B$3
Cell $B$5 has moved to $B$4
Cell $B$6 has moved to $B$5
Cell $B$7 has moved to $B$6
Cell $B$8 has moved to $B$7
Cell $B$9 has moved to $B$8
Cell $B$10 has moved to $B$9
Cell $B$11 has moved to $B$10
Cell $B$12 has moved to $B$11
Cell $B$13 has moved to $B$12
Cell $B$14 has moved to $B$13
Cell $B$15 has moved to $B$14
Cell $B$16 has moved to $B$15
Cell $B$17 has moved to $B$16
Cell $B$18 has moved to $B$17
Cell $B$19 has moved to $B$18
Cell $B$20 has moved to $B$19
Cell $B$21 has moved to $B$20
Cell $B$22 has moved to $B$21
Cell $B$23 has moved to $B$22
Cell $B$24 has moved to $B$23
Cell $B$25 has moved to $B$24
Cell $B$26 has moved to $B$25
Cell $B$27 has moved to $B$26
Cell $B$28 has moved to $B$27
Cell $B$29 has moved to $B$28
Cell $B$30 has moved to $B$29
Cell $B$31 has moved to $B$30
Cell $B$32 has moved to $B$31
Cell $B$33 has moved to $B$32
Cell $B$34 has moved to $B$33
Cell $B$35 has moved to $B$34
Cell $B$36 has moved to $B$35
Cell $B$37 has moved to $B$36
Cell $B$38 has moved to $B$37
Cell $B$39 has moved to $B$38
Cell $B$40 has moved to $B$39
Cell $B$41 has moved to $B$40
Cell $B$42 has moved to $B$41

Seems to work pretty nicely here, with a limited number of cells. I wouldn't run this across an entire worksheet (or its UsedRange), but it gives an idea of how to go about it.

  • Related