No you CANNOT have more of the same

I like Doug Glancy’s UndoSelections code via his Selectracker utility. It allows you to deselect a cell from a selection that you made while holding the Ctrl Key…something that Excel doesn’t let you do out of the box. Nifty.

(Aside: If you’re NOT a Ctrl freak, then you can also put Excel into Add To Selection mode by pushing Shift + F8, which adds any further cells you click on to the current selection without the need to hold down Ctrl. When you’ve got the cells you want, just push Shift + F8 again.)

I thought I’d try a simpler approach…if the user tries to select something that’s already selected, simply dump it from the current selection. So I came up with this:


Private Sub Workbook_Open()
Set App = Application
End Sub

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Deselect Target
End Sub

Sub Deselect(Target As Range)
Dim lngCount As Long
Dim lngLast As Long
Dim strTarget As String
Dim strOld As String
Dim strNew As String

'This code allows you to deselect cells when CTRL + Clicking
strTarget = Target.Address
lngCount = UBound(Split(strTarget, ","))
If lngCount > 0 Then
strNew = "," & Split(strTarget, ",")(lngCount) & ","
'Need to add the "," as a delimiter so we don't incorrectly identify say $A$1 and $A$10 as the same
strOld = "," & Left(strTarget, Len(strTarget) - Len(strNew) + 1) & ","
If InStr(strOld, strNew) > 0 Then
If strOld <> strNew Then
strOld = Replace(strOld, strNew, ",")
End If
If Right(strOld, 1) = "," Then strOld = Left(strOld, Len(strOld) - 1)
If Left(strOld, 1) = "," Then strOld = Mid(strOld, 2, Len(strOld))
Application.EnableEvents = False
Range(strOld).Select
Range(Split(strOld, ",")(UBound(Split(strOld, ",")))).Activate
Application.EnableEvents = True
End If
End If
End Sub

Here’s an illustration: below is a screenshot where I was trying to select cells in a Checker-board pattern while holding Ctrl, but made a stuff-up a couple of clicks ago:
 

Selection1

 
 

Without VBA, I’d need to start from scratch, because Excel doesn’t let you deselect particular blocks from your current selection. But with my trusty code, all I need to do is try to select the offending block again, and Excel will say Hey…you’ve already got that in your selection. Oh wait…I guess you’re trying to tell me that you want to dump that particular range from the selection, given it’s already selected.

And so it does just that:
 
Selection2
 
 
…which frees me up to try again:
 
Selection4
 
 
In fact, as long as I keep holding Ctrl down, I can deselect as many ranges as I want:
Selection5

It works pretty well. See for yourself: Open the below sample file, hold Ctrl down and do some crazy clicking, and occasionally click something you’ve already selected. ZAP! It’s removed from the current selection.
Unselect_20141111 v3 (Note: I’ve updated this file with snb’s version of the code listed further below.)

Why this isn’t the native behavior right out of the box is beyond me.

There’s bound to be coding improvements, so let’s have ’em.

—UPDATE—

snb has a much smarter approach in the comments that lets users deselect individual cells within a particular subs-selection OR deselect a sub-selection in its entirety. I’ve amended the sample file accordingly.

His approach goes a little something like so:

Private WithEvents App As Application
Option Explicit

Private Sub Workbook_Open()
Set App = Application
End Sub

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Deselect Target
End Sub

Sub Deselect(Target As Range)

Dim rn As Range
Dim cl As Range
Dim sel As Range
On Error Resume Next
Set rn = Target.Areas(Target.Areas.Count)

If Target.Count > 1 And Target.Areas.Count > 1 Then
If Not Intersect(Range(Replace(Target.Address & "~", "," & rn.Address & "~", "")), rn) Is Nothing Then
For Each cl In Target
If Intersect(cl, rn) Is Nothing Then Set sel = Union(sel, cl)
If Err.Number <> 0 Then Set sel = cl
Err.Clear
Next
sel.Select
End If
End If
End Sub

And so with SNB’s code, if I were to select a block:
 
snb block
 
 
…and I wanted to ditch the cell in the middle, then I can simply select it while holding Ctrl, and it gets ditched:
 
snb block 2
 
 
Meaning that I can then say apply formatting, to create an in-cell donut:
 
snb block 3
 
 
Much better than my approach. Cheers, snb!

40 thoughts on “No you CANNOT have more of the same

  1. Maybe ?

    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
        Set Rn = Target.Areas(Target.Areas.Count)
        
        If Target.Count > 1 And Rn.Count = 1 Then
          If Not Intersect(Range(Replace(Target.Address & "~", "," & Rn.Address & "~", "")), Rn) Is Nothing Then
            Set sel = Target.Cells(1)
            For Each cl In Target
                If cl.Address <>  Rn.Address Then Set sel = Union(sel, cl)
            Next
            sel.Select
          End If
        End If
    End Sub
  2. Hi snb. Great approach. Could do with a bit more tweaking though…currently it doesn’t let you deselect the first cell you selected, and it only works for single cell selections. But I like the approach.

    I never knew about the .Areas property.

  3. Thanks for the plug Jeff!

    I’m compelled to point out that you are solving a different issue than me.

    The problem my SelecTracker addresses is when, while holding down the Ctrl key to select multiple areas, you select one you didn’t mean to. It allows you do de-select any of them without having to start over.

    While developing it I noticed the thing you’re addressing: the fact that you can select the same cell multiple times while pressing Ctrl, perhaps in a futile effort to de-select it. So for example you can end up with:

    Selection.Address = "$A$1,$A$1,$A$1,$A$1,$A$1"

    I think that's peculiar and interesting, but am not sure when I'd need to prevent it.

  4. Hi Doug. The problem my SelecTracker addresses is when, while holding down the Ctrl key to select multiple areas, you select one you didn’t mean to. It allows you do de-select any of them without having to start over.

    Yup, my code does that too. So if I’ve selected A1, A3, and A5, and I want to deselect any one of them without losing my current selection, then all I need to do is select it again, and the code will say “Oh, I’ve already got that in my selection, and I guess what you’re trying to do is unselect it”.

    Hold down Ctrl, select a whole bunch of non-contiguous cells, and you’ll find that you can dump any of the ranges merely by clicking on them again (while still holding Ctrl).

    A picture is worth a thousand words. Unfortunately I couldn’t upload one yesterday due to a WordPress setting. I’ll upload one now.

  5. @Jeff, I understand now. Thanks for the pictures! I downloaded the sample file and tried it out.

    It seems to work well with non-contiguous areas as you say, and with single-cell contiguous sections. With contiguous multiple-cell selections it merges some areas together. For an example select A1:A2, B1:B2 and C1:C2 and then click into A2. Here’s the addresses I get for each step:

    $A$1:$A$2
    $A$1:$A$2,$B$1:$B$2
    $A$1:$A$2,$B$1:$B$2,$C$1:$C$2
    $A$1:$B$2,$C$1:$C$2

    You can see A1:A2 merge with B1:B2 on-screen as well.

    One more example:

    Select A1:B2 then B2:C3, and then click in B2. You end up with a single selection in A1:C3.

    $A$1:$B$2
    $A$1:$B$2,$B$2:$C$3
    $A$1:$C$3

  6. As to why deselecting isn’t native out of the box… my guess is that’s it’s too confusing when overlapping ranges are selected. Do you select the ones that weren’t selected before and deselect the ones that overlap? That seems most logical in a way, but confusing in practice. In a way just reselecting cells as many times as they’re selected might make the most sense.

  7. Something I forgot to add into the post until now was this: If you’re NOT a Ctrl freak, then you can also put Excel into Add To Selection mode by pushing Shift + F8, which adds any cells you click on to the current selection without the need to hold down Ctrl. When you’ve got the cells you want, just push Shift + F8 again.

  8. I’d prefer:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    Set Rn = Target.Areas(Target.Areas.Count)

    If Target.Count > 1 And Target.Areas.Count > 1 Then
    If Not Intersect(Range(Replace(Target.Address & "~", "," & Rn.Address & "~", "")), Rn) Is Nothing Then
    For Each cl In Target
    If Intersect(cl, Rn) Is Nothing Then Set sel = Union(sel, cl)
    If Err.Number <> 0 Then Set sel = cl
    Err.Clear
    Next
    sel.Select
    End If
    End If
    End Sub

    I fear your code doesn't discern a cell that is part of one of the areas. That doens't show at least in the area's address.

  9. I fear your code doesn’t discern a cell that is part of one of the areas. That doens’t show at least in the area’s address.

    You’re correct: it doesn’t. By choice. Because the aim is to let users deselect complete areas from the current selection. Areas that may be more than just single cells.

    For instance, given this selection:
    ? selection.address
    $B$4,$D$4:$F$9,$B$13,$E$18,$F$14:$F$15,$H$14:$I$16,$H$8,$C$16

    …which is made up of this many areas:
    ? selection.areas.count
    8

    …I want to allow the user to deselect any one of those 8 areas in their entirety. I don’t want to amend any of those areas. I want to deselect an unwanted area entirely. My code allows that, regardless of whether the area is made up of one cell such as that first area – $B$4 – or multiple cells such as that second area – $D$4:$F$9.

  10. My code does exactly what you wondered to be an absent facility in Excel (including the particular case of your code) :

    – If a selection consists of more than 1 cell, the selection definition should never contain selected cells twice.
    – If a selection has been added to the selection definition and that selection is already part of the selection, it means that the ‘new’ selection should be unselected (whether it’s only one cell, a range of cells or an exact match to one of the areas in the existing selection (your case)).

  11. This is definitely going in my personal macro workbook.
    I didn’t like how the window scrolled after the new range was selected, so I captured the original ScrollRow and ScrollColumn, then set them after the new range was selected.

    lRow = ActiveWindow.ScrollRow
    lCol = ActiveWindow.ScrollColumn

    'good stuff here
    '.select

    With ActiveWindow
    .ScrollRow = lRow
    .ScrollColumn = lCol
    End With

  12. @Jeff “Ctrl freak” – wish I’d thought of that!

    So, with your larest, select A1:A2 then A1:

    $A$1:$A$2
    $A$1:$A$2,$A$1

    @snb, select A1:A2, B1:B2 and C1:C2 and then click into A2. Here’s what Debug.Print Selection.Address in the code yields:

    $A$1:$A$2
    $A$1:$A$2,$B$1:$B$2
    $A$1:$A$2,$B$1:$B$2,$C$1:$C$2
    $A$1:$C$1,$B$2:$C$2

    Select A1:B2 then B2:C3:

    $A$1:$B$2
    $A$1:$B$1,$A$2

    Clearly, this type of coding is really hard, as you have to anticipate everything Excel is going to do and, to a certain extent, fight against it. I know, sounds like a lot of VBA projects. One of the reasons I enjoyed writing the SelecTracker code is that it brings Excel’s, admittedly odd, behavior regarding multiple selections to the surface , and let’s you adjust selections using that same behavior.

  13. @doug

    No big deal:

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next

    If Target.Count > 1 And Target.Areas.Count > 1 Then
    Set Rn = Target.Areas(Target.Areas.Count)
    If Not Intersect(Range(Replace(Target.Address & "~", "," & Rn.Address & "~", "")), Rn) Is Nothing Then
    For Each cl In Target
    If Intersect(cl, Rn) Is Nothing Then Set sel = Union(sel, cl)
    If Err.Number <> 0 Then Set sel = cl
    Err.Clear
    Next
    For Each cl In Rn
    If Intersect(sel, cl) Is Nothing Then Set sel = Union(sel, cl)
    Next
    sel.Select
    Debug.Print sel.Address
    End If
    End If
    End Sub

  14. Last amendment:

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      On Error Resume Next
       
      If Target.Count > 1 And Target.Areas.Count > 1 Then
        Set Rn = Target.Areas(Target.Areas.Count)
        If Not Intersect(Range(Replace(Target.Address & "~", "," & Rn.Address & "~", "")), Rn) Is Nothing Then
          y = Intersect(Range(Replace(Target.Address & "~", "," & Rn.Address & "~", "")), Rn).Address = Intersect(Target, Rn).Address
          For Each cl In Target
            If y Then
               If Intersect(cl, Rn) Is Nothing Then Set sel = Union(sel, cl)
            Else
               Set sel = Union(sel, cl)
            End If
            If Err.Number <> 0 Then Set sel = cl
            Err.Clear
          Next
          sel.Select
        End If
      End If
    End Sub
  15. @Doug: So, with your larest, select A1:A2 then A1 Yes, but that’s more or less the correct behavior that I want.

    • I don’t want users to be able to select the exact same area twice, and I’m using the VBA definition of area here.
    • I want them to be able to deselect any already selected area they want. And they can in this case…they can deselect A1 by trying to reselect A1, and they can deselect A1:A2 by trying to reselect A1:A2.
  16. @snb: Your approach of letting users deselect individual cells within a current VBA area OR deselect the entire VBA area is a much smarter approach than mine. Awesome! I’ll add it to the article above.

  17. Jeff, that makes sense. Having a user understand what’s happening when they select A1:A2 and then select A2 three times in a row could be tough. But who’s going to do that? :-) Beyond that, it’s working great, and just as you specify.

    @snb, I know that was your last amendment, so I won’t comment any more. (I’m a big admirer of your coding skills by the way.)

  18. I thought the code needed still some more ‘polishing’.

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      On Error Resume Next
       
      If Target.Count > 1 And Target.Areas.Count > 1 Then
        Set R_n = Target.Areas(Target.Areas.Count)
        Set R_p = Range(Replace(Target.Address & "~", "," & Rn.Address & "~", ""))
       
        If Not Intersect(R_p, R_n) Is Nothing Then
          y = Intersect(R_p, R_n).Address = Intersect(Target, R_n).Address
          
          For Each cl In Target
            If y * Not Intersect(cl, R_n) Is Nothing = 0 Then Set R_q = Union(R_q, cl)
            If Err.Number <> 0 Then Set R_q = cl
            Err.Clear
          Next
          
          R_q.Select
        End If
      End If
        
    End Sub
  19. Nice. I changed this:

    Set R_p = Range(Replace(Target.Address & "~", "," & Rn.Address & "~", ""))

    …to this:

    Set R_p = Range(Replace(Target.Address & "~", "," & R_n.Address & "~", ""))

    …on the assumption that the first was an error.

    And I can suggest two areas of further polishing, since you’ve got the cloth and furniture oil out:
    1. Application.EnableEvents = False
    R_q.Select
    Application.EnableEvents = True

    2. If you only have one cell selected (e.g. A1) then currently the code will let you reselect that cell over and over. e.g. click on A1 multiple times. Not that it matters.

  20. You guys are still going at this!

    When I run snb’s code currently listed in the post itself, I get almost the same results as in my comment yesterday:

    Select A1:A2, B1:B2 and C1:C2 and then A2. Here’s what Debug.Print Selection.Address in the code yields:
    $A$1:$A$2
    $A$1:$A$2,$B$1:$B$2
    $A$1:$A$2,$B$1:$B$2,$C$1:$C$2
    $A$1:$C$1,$B$2:$C$2

    Select A1:B2 then B2:C3. I get:
    $A$1:$B$2
    $A$1:$B$1,$A$2

  21. Yes. In the first case I’d expect A2 to be deselected with a result of:
    $A$1,$B$1:$B$2,$C$1:$C$2

    For the second I’m not sure what would be correct, but I’d expect part of the second selection to show up. What it does is remove B2 from the first selection and ignores the rest.

    Is that what you’d expect for these?

  22. Ahhhhhhhhhhhhhhhhhhhhhh. I probably use it to fill colors or to change number formatting. So that’s not an issue for me. I never thought about doing borders this way. Love the animated post.

  23. I was looking for it for the almost same reason as Doug, but where I only wanted an outline of the whole irregular selection and realized it wouldn’t work the way Excel draws borders, so I ended up having to delete some borders in adjacent cells.
    So in combination with the Deselect code it achieves the purpose


    Sub BorderOutlineMultSel()
    'Jörgen Möller 13Nov2014
    'This macro sets a border outlining a selection (simple or created with ctrl-)
    'Any existing borders within the selection disappears
    Dim Ruta As Range, rge As Range
    Set rge = Selection
    rge.BorderAround Weight:=xlMedium
    On Error Resume Next ' to take care of first/last row and column
    For Each Ruta In rge.Cells
    With Ruta
    If Not Intersect(.Offset(0, 1), rge) Is Nothing Then .Borders(xlEdgeRight).LineStyle = xlNone
    If Not Intersect(.Offset(0, -1), rge) Is Nothing Then .Borders(xlEdgeLeft).LineStyle = xlNone
    If Not Intersect(.Offset(-1, 0), rge) Is Nothing Then .Borders(xlEdgeTop).LineStyle = xlNone
    If Not Intersect(.Offset(1, 0), rge) Is Nothing Then .Borders(xlEdgeBottom).LineStyle = xlNone
    End With
    Next Ruta
    On Error GoTo 0
    End Sub

  24. Doug, Jeff, Dick, snb,

    When I first posted my question I had a fantasy that someone here would run with it, but you all have far exceeded my expectations. I’m many steps behind y’all in my VBA abilities, and imagined that there would be some sort of stack, similar to the undo stack, that could be utilized to undo a selection. Obviously that wasn’t quite the right way to approach the problem, and I tip my hat to all of you for coming up with the solution(s).

    Time to go add some code to my personal.xlsb file.

    Thank you all so much!

    VvM

  25. I would like to propose changing this line of code in snb’s last “polished” code posting…

    Set R_p = Range(Replace(Target.Address & “~”, “,” & Rn.Address & “~”, “”))

    to this…

    Set R_p = Range(Replace(Target.Address(0, 0) & “~”, “,” & R_N.Address(0, 0) & “~”, “”))

    Note the two (0,0)’s that I post-fixed to two addresses… the Range object’s string argument is limited to 255 (or maybe its 256) charaacters… using the (0,0) post-fix removes the $ signs from the resulting string argument meaning more cells can be deselected before having to worry about running into the 255-character limit.

  26. @Rick

    In that case we should avoid those ‘address’ limitations alltogether.

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next

    If Target.Count > 1 And Target.Areas.Count > 1 Then
    Set R_n = Target.Areas(Target.Areas.Count)

    Set R_p = Target.Areas(1)
    For j = 2 To Target.Areas.Count - 1
    Set R_p = Union(R_p, Target.Areas(j))
    Next

    If Not Intersect(R_p, R_n) Is Nothing Then
    y = Intersect(R_p, R_n).Address = Intersect(Target, R_n).Address

    For Each cl In Target
    If y * Not Intersect(cl, R_n) Is Nothing = 0 Then Set R_q = Union(R_q, cl)
    If Err.Number <> 0 Then Set R_q = cl
    Err.Clear
    Next

    R_q.Select
    End If
    End If

    End Sub

  27. @snb,

    Now the only thing left to do is overcome the slowness of the Union method. To see what I mean, select an entire column and then Control Click the first cell of that column to deselect the header (deselecting any cell or cells would do, but I figured “shortcut” selecting an entire column minus a header cell might mimic something a person might really do with your code). You will have to wait a short while, so be patient… whatever you do, do not select every cell on the worksheet (in order to clear the worksheet for example)… you will not be willing to wait as long as it will take to regain control of Excel.

  28. While a code might not be the best choice in 1 promille of ever (not)happening situations, it’s not a reason not to use it for all the other cases.
    I have no pretensions to create ‘exotics’proof code.
    I focus on the majority of cases not on the exceptions.

  29. Thanks for the heads-up Rick…I’ll make some amendments in due course…I don’t want to expose users (including me) to a long wait if they happen to do that.

  30. Thinking about this some more, a much faster way to accomplish this might be to use my code for exact matches – i.e.

    1. if you select an additional area that exactly matches one of the existing target.areas then it gets unselected as per my original code.
    2. If you select an additional area that intersects one of the existing target.areas, then the union between the new area and the existing area gets unselected, but not by iterating through cells one by one.

    Instead, the particular area gets intelligently rebuilt. And this should take no more than 3 discrete blocks, as per the below screenshot example.
    Ranges

Leave a Reply

Your email address will not be published. Required fields are marked *