Invert filter selection in Excel

Question

I'm asking a question that I plan to answer so I can document this problem in a lasting way. More than happy for others to pitch in with other suggestions / corrections.

I often have an issue in Excel where I'm using filters and then want to invert the selection i.e. unpick all the items that have been picked and pick all the items that are not currently picked. For example, see screenshots below:

There's no easy way to do this (that I know of!) other than clicking through the list, which laborious and error prone. How can we get this functionality automated in Excel?

Before:

After:

Solution 1

I've written a bit of VBA that extends Excel and provides this functionality. It adds a new context menu (right-click menu) option off the Filter sub-menu (see screenshot).

You need to call the AddToCellMenu subroutine to make the menu item appear. If you want to make that permament for all your Excel sessions, you'll need to put this code in a personal workbook or add-in you have running and then call AddToCellMenu on the Workbook_Open event, or something similar.

Anyway here's the code:

Option Explicit

Public Sub AddToCellMenu(dummy As Byte)

Dim FilterMenu As CommandBarControl

    ' Delete the controls first to avoid duplicates
    Call DeleteFromCellMenu

    ' Set ContextMenu to the Cell context menu
    ' 31402 is the filter sub-menu of the cell context menu
    Set FilterMenu = Application.CommandBars("Cell").FindControl(ID:=31402)

    ' Add one custom button to the Cell context menu
    With FilterMenu.Controls.Add(Type:=msoControlButton, before:=3)
        .OnAction = "'" & ThisWorkbook.name & "'!" & "InvertFilter"
        .FaceId = 1807
        .Caption = "Invert Filter Selection"
        .Tag = "My_Cell_Control_Tag"
    End With

End Sub

Private Sub DeleteFromCellMenu()

Dim FilterMenu As CommandBarControl
Dim ctrl As CommandBarControl

    ' Set ContextMenu to the Cell context menu
    ' 31402 is the filter sub-menu of the cell context menu
    Set FilterMenu = Application.CommandBars("Cell").FindControl(ID:=31402)

    ' Delete the custom controls with the Tag : My_Cell_Control_Tag
    For Each ctrl In FilterMenu.Controls
        If ctrl.Tag = "My_Cell_Control_Tag" Then
            ctrl.Delete
        End If
    Next ctrl

End Sub

Public Sub InvertFilter()

Dim cell As Range
Dim af As AutoFilter
Dim f As Filter
Dim i As Integer

Dim arrCur As Variant
Dim arrNew As Variant
Dim rngCol As Range
Dim c As Range
Dim txt As String
Dim bBlank As Boolean

    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' INITAL CHECKS
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Set cell = ActiveCell
    
    Set af = cell.parent.AutoFilter

    If af Is Nothing Then
        MsgBox "No filters on current sheet"
        Exit Sub
    End If
    
    If Application.Intersect(cell, af.Range) Is Nothing Then
        MsgBox "Current cell not part of filter range"
        Exit Sub
    End If
    
    i = cell.Column - af.Range.cells(1, 1).Column + 1
    Set f = af.Filters(i)
    
    If f.On = False Then
        MsgBox "Current column not being filtered. Nothing to invert"
        Exit Sub
    End If
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' GET CURRENT FILTER DATA
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    ' Single value criteria
    If f.Operator = 0 Then
        If f.Criteria1 = "<>" Then ArrayAdd arrNew, "="
        If f.Criteria1 = "=" Then ArrayAdd arrNew, "<>"
        ArrayAdd arrCur, f.Criteria1
    ' Pair of values used as criteria
    ElseIf f.Operator = xlOr Then
        ArrayAdd arrCur, f.Criteria1
        ArrayAdd arrCur, f.Criteria2
    ' Multi list criteria
    ElseIf f.Operator = xlFilterValues Then
        arrCur = f.Criteria1
    Else
        MsgBox "Current filter is not selecting values. Cannot process inversion"
        Exit Sub
    End If
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' COMPUTE INVERTED FILTER DATA
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    ' Only process if new list is empty
    ' Being non-empty implies we're just toggling blank state and new list is already determined for that
    If IsEmpty(arrNew) Then
    
        ' Get column of data, ignoring header row
        Set rngCol = af.Range.Resize(af.Range.Rows.Count - 1, 1).Offset(1, i - 1)
        bBlank = False
        
        For Each c In rngCol
            
            ' Ignore blanks for now; they get special processing at the end
            If c.Text <> "" Then
                
                ' If the cell text is in neither the current filter list ...
                txt = "=" & c.Text
                If Not ArrayContains(arrCur, txt) Then
                
                    ' ... nor the new proposed list then add it to the new proposed list
                    If Not ArrayContains(arrNew, txt) Then ArrayAdd arrNew, txt
                
                End If
            
            Else
                ' Record that we have blank cells
                bBlank = True
            End If
            
        Next c
        
        ' Process blank options
        ' If we're not currently selecting for blanks ...
        ' ... and there are blanks ...
        ' ... then filter for blanks in new selection
        If (Not arrCur(UBound(arrCur)) = "=" And bBlank) Then ArrayAdd arrNew, "="
    
    End If
    
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' APPLY NEW FILTER
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
    Select Case UBound(arrNew)
        Case 0:
            MsgBox "Didn't find any values to invert"
            Exit Sub
        Case 1:
            af.Range.AutoFilter _
                Field:=i, _
                Criteria1:=arrNew(1)
        Case 2:
            af.Range.AutoFilter _
                Field:=i, _
                Criteria1:=arrNew(1), _
                Criteria2:=arrNew(2), _
                Operator:=xlOr
        Case Else:
            af.Range.AutoFilter _
                Field:=i, _
                Criteria1:=arrNew, _
                Operator:=xlFilterValues
    End Select

End Sub

Private Sub ArrayAdd(ByRef a As Variant, item As Variant)

Dim i As Integer

    If IsEmpty(a) Then
        i = 1
        ReDim a(1 To i)
    Else
        i = UBound(a) + 1
        ReDim Preserve a(1 To i)
    End If
    
    a(i) = item

End Sub

Private Function ArrayContains(a As Variant, item As Variant) As Boolean

Dim i As Integer

    If IsEmpty(a) Then
        ArrayContains = False
        Exit Function
    End If
    
    For i = LBound(a) To UBound(a)
        If a(i) = item Then
            ArrayContains = True
            Exit Function
        End If
    Next i
    
    ArrayContains = False

End Function

' Used to find the menu IDs
Private Sub ListMenuInfo()

Dim row As Integer
Dim Menu As CommandBarControl
Dim MenuItem As CommandBarControl
Dim SubMenuItem As CommandBarControl

    row = 1
    On Error Resume Next
    For Each Menu In CommandBars("cell").Controls
        For Each MenuItem In Menu.Controls
            For Each SubMenuItem In MenuItem.Controls
                cells(row, 1) = Menu.Caption
                cells(row, 2) = Menu.ID
                cells(row, 3) = MenuItem.Caption
                cells(row, 4) = MenuItem.ID
                cells(row, 5) = SubMenuItem.Caption
                cells(row, 6) = SubMenuItem.ID
                row = row + 1
            Next SubMenuItem
        Next MenuItem
    Next Menu
    
End Sub

Solution 2

I've turned off screen updating to speed this up. Also removed the redundant argument from AddToCellMenu as it caused errors when calling from my Personal.xlsb.

Quick full instruction to permanently add the inverse filter option to your Excel:

1. Read up on how to create your Personal.xlsb

2. Paste this code to your Personal's ThisWorkbook object (Developer -> Visual Basic -> double click ThisWorkbook):

   Private Sub Workbook_Open()
       Windows("Personal.xlsb").Visible = False
       Call AddToCellMenu
   End Sub
   

3. Paste James' updated code in a new module inside your Personal.xlsb:

   Option Explicit
   
   Public Sub AddToCellMenu()
   
   Dim FilterMenu As CommandBarControl
   
       ' Delete the controls first to avoid duplicates
       Call DeleteFromCellMenu
   
       ' Set ContextMenu to the Cell context menu
       ' 31402 is the filter sub-menu of the cell context menu
       Set FilterMenu = Application.CommandBars("Cell").FindControl(ID:=31402)
   
       ' Add one custom button to the Cell context menu
       With FilterMenu.Controls.Add(Type:=msoControlButton, before:=3)
           .OnAction = "'" & ThisWorkbook.name & "'!" & "InvertFilter"
           .FaceId = 1807
           .Caption = "Invert Filter Selection"
           .Tag = "My_Cell_Control_Tag"
       End With
   
   End Sub
   
   Private Sub DeleteFromCellMenu()
   
   Dim FilterMenu As CommandBarControl
   Dim ctrl As CommandBarControl
   
       ' Set ContextMenu to the Cell context menu
       ' 31402 is the filter sub-menu of the cell context menu
       Set FilterMenu = Application.CommandBars("Cell").FindControl(ID:=31402)
   
       ' Delete the custom controls with the Tag : My_Cell_Control_Tag
       For Each ctrl In FilterMenu.Controls
           If ctrl.Tag = "My_Cell_Control_Tag" Then
               ctrl.Delete
           End If
       Next ctrl
   
   End Sub
   
   Public Sub InvertFilter()
   
   Application.ScreenUpdating = False
   
   Dim cell As Range
   Dim af As AutoFilter
   Dim f As Filter
   Dim i As Integer
   
   Dim arrCur As Variant
   Dim arrNew As Variant
   Dim rngCol As Range
   Dim c As Range
   Dim txt As String
   Dim bBlank As Boolean
   
       ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ' INITAL CHECKS
       ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   
       Set cell = ActiveCell
   
       If cell.parent.AutoFilterMode = False Then
           MsgBox "No filters on current sheet"
           Exit Sub
       End If
   
       Set af = cell.parent.AutoFilter
   
       If Application.Intersect(cell, af.Range) Is Nothing Then
           MsgBox "Current cell not part of filter range"
           Exit Sub
       End If
   
       i = cell.Column - af.Range.cells(1, 1).Column + 1
       Set f = af.Filters(i)
   
       If f.On = False Then
           MsgBox "Current column not being filtered. Nothing to invert"
           Exit Sub
       End If
   
       ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ' GET CURRENT FILTER DATA
       ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   
       ' Single value criteria
       If f.Operator = 0 Then
           If f.Criteria1 = "<>" Then ArrayAdd arrNew, "="
           If f.Criteria1 = "=" Then ArrayAdd arrNew, "<>"
           ArrayAdd arrCur, f.Criteria1
       ' Pair of values used as criteria
       ElseIf f.Operator = xlOr Then
           ArrayAdd arrCur, f.Criteria1
           ArrayAdd arrCur, f.Criteria2
       ' Multi list criteria
       ElseIf f.Operator = xlFilterValues Then
           arrCur = f.Criteria1
       Else
           MsgBox "Current filter is not selecting values. Cannot process inversion"
           Exit Sub
       End If
   
       ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ' COMPUTE INVERTED FILTER DATA
       ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   
       ' Only process if new list is empty
       ' Being non-empty implies we're just toggling blank state and new list is already determined for that
       If IsEmpty(arrNew) Then
   
           ' Get column of data, ignoring header row
           Set rngCol = af.Range.Resize(af.Range.Rows.Count - 1, 1).Offset(1, i - 1)
           bBlank = False
   
           For Each c In rngCol
   
               ' Ignore blanks for now; they get special processing at the end
               If c.Text <> "" Then
   
                   ' If the cell text is in neither the current filter list ...
                   txt = "=" & c.Text
                   If Not ArrayContains(arrCur, txt) Then
   
                       ' ... nor the new proposed list then add it to the new proposed list
                       If Not ArrayContains(arrNew, txt) Then ArrayAdd arrNew, txt
   
                   End If
   
               Else
                   ' Record that we have blank cells
                   bBlank = True
               End If
   
           Next c
   
           ' Process blank options
           ' If we're not currently selecting for blanks ...
           ' ... and there are blanks ...
           ' ... then filter for blanks in new selection
           If (Not arrCur(UBound(arrCur)) = "=" And bBlank) Then ArrayAdd arrNew, "="
   
       End If
   
       ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
       ' APPLY NEW FILTER
       ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   
       Select Case UBound(arrNew)
           Case 0:
               MsgBox "Didn't find any values to invert"
               Exit Sub
           Case 1:
               af.Range.AutoFilter _
                   Field:=i, _
                   Criteria1:=arrNew(1)
           Case 2:
               af.Range.AutoFilter _
                   Field:=i, _
                   Criteria1:=arrNew(1), _
                   Criteria2:=arrNew(2), _
                   Operator:=xlOr
           Case Else:
               af.Range.AutoFilter _
                   Field:=i, _
                   Criteria1:=arrNew, _
                   Operator:=xlFilterValues
       End Select
   
   Application.ScreenUpdating = True
   
   End Sub
   
   Private Sub ArrayAdd(ByRef a As Variant, item As Variant)
   
   Dim i As Integer
   
       If IsEmpty(a) Then
           i = 1
           ReDim a(1 To i)
       Else
           i = UBound(a) + 1
           ReDim Preserve a(1 To i)
       End If
   
       a(i) = item
   
   End Sub
   
   Private Function ArrayContains(a As Variant, item As Variant) As Boolean
   
   Dim i As Integer
   
       If IsEmpty(a) Then
           ArrayContains = False
           Exit Function
       End If
   
       For i = LBound(a) To UBound(a)
           If a(i) = item Then
               ArrayContains = True
               Exit Function
           End If
       Next i
   
       ArrayContains = False
   
   End Function
   
   ' Used to find the menu IDs
   Private Sub ListMenuInfo()
   
   Dim row As Integer
   Dim Menu As CommandBarControl
   Dim MenuItem As CommandBarControl
   Dim SubMenuItem As CommandBarControl
   
       row = 1
       On Error Resume Next
       For Each Menu In CommandBars("cell").Controls
           For Each MenuItem In Menu.Controls
               For Each SubMenuItem In MenuItem.Controls
                   cells(row, 1) = Menu.Caption
                   cells(row, 2) = Menu.ID
                   cells(row, 3) = MenuItem.Caption
                   cells(row, 4) = MenuItem.ID
                   cells(row, 5) = SubMenuItem.Caption
                   cells(row, 6) = SubMenuItem.ID
                   row = row + 1
               Next SubMenuItem
           Next MenuItem
       Next Menu
   
   End Sub
   

4. Still in your Personal.xslb, go to View tab, then hit "hide", and it won't bother you anymore, ever. :)

Save the file and restart your Excel. The inverse filter option will be added automatically each time you open any Excel file.

Solution 3

I've been trying to solve this issue for some time and think I just discovered a pretty easy way to inverse the filter. Just highlight the current cells, then remove the filter. Now filter again by everything not highlighted and there you go. Hope that helps, it certainly worked for what I needed.

Comments

[James MacAdie]

The redundant argument from AddToCellMenu was put in to 'hide' the routine from the Run Macro (ALT + F8) dialog. It's a trick I often use. Thanks for documenting properly how to add it permanently to your Excel application

[BiLaL]

Thanks for the tip. It is just one of the workarounds that can be used in such situation. excel.uservoice.com/forums/… here is an formal request for this feature and Microsoft took four years to acknowledge its importance.

[kett]

It's not working if data is formatted as table.

[kett]

It's not working if the data is formatted as table.

[James MacAdie]

Sorry I don't work with tables much. You could try changing to thisSet af = cell.parent.AutoFilter If af Is Nothing Then MsgBox "No filters on current sheet" Exit Sub End If

[James MacAdie]

In place of If cell.parent.AutoFilterMode = False Then MsgBox "No filters on current sheet" Exit Sub End If Set af = cell.parent.AutoFilter. In quick tests this seems to work. I'll test a bit more and update my answer above if it's still looking good

[James MacAdie]

Testing completed ... it seems to work & now applies to tables as well as standard autofilters on a worksheet. I've updated my answer above but not Trymzet's that we're commenting on. Thanks for catching this

[James MacAdie]

It should do now. I have updated the code

[buergi]

For me it only works with cell.Parent.AutoFilter Is Nothing instead of cell.parent.AutoFilterMode = False. Otherwise I'm always getting "No filters on current sheet" even if there are some.

[kett]

Great. It's working now. Thank you! BUT I had to change line 3 of the ThisWorkbook Object Code to Call AddToCellMenu(dummy = ""). Without this, I got an "argument is not optional" error!

[kett]

It works for me with @JamesMacAdie 's Code. BUT I had to change line 3 of the ThisWorkbook Object Code to Call AddToCellMenu(dummy = ""). Without that, I got an "argument is not optional" error!

[James MacAdie]

Hey @kett thanks for reverting. See my earlier comment about using this to hide the routine from Run Macro. It's a bit niche and I appreciate not the clearest code to have included. You have found one of the workarounds, with Michal's suggestion of dropping the parameter being the other. Sorry!