Dim MemoSel As Range, NewSel As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If MemoSel Is Nothing Then Set MemoSel = Selection: Exit Sub
If MemoSel.Address = Target.Address Then Exit Sub
Dim c As Range, cel As Range
For Each c In Target
If Intersect(c, MemoSel) Is Nothing Then GoTo 1
Next c
Application.EnableEvents = False
Set NewSel = Nothing
For Each cel In MemoSel
If Intersect(cel, Target) Is Nothing Then
If NewSel Is Nothing Then
Set NewSel = cel
Else
Set NewSel = Union(NewSel, cel)
End If
End If
Next
NewSel.Select
Application.EnableEvents = True
1 Set MemoSel = Selection
End Sub