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.