Inversely filter a Pivot based on an external range

Howdy folks. Jeff here, with a money-saving Christmas tip. Oh, and some PivotTable code.

I recently posted a routine to filter pivots based on an external range. My code worked out whether it was fastest to either:

  1. Hide all items in the field, then unhide those Pivot Items that matched the search terms; or
  2. Unhide all items in the field, then hide those Pivot Items that don’t match the search terms.

It worked out what to hide or leave by adding the Search Terms to a Dictionary, then trying to add the Pivot Items and catching any errors. In that first case where it unhides Pivot Items that match the search terms, here’s the code that did the dictionary check on the PivotItems – after the Search Terms had already been added:

With dic
    For Each pi In pfOriginal.PivotItems
        dic.Add pi.Value, 1 'The 1 does nothing
        If Err.Number <> 0  Then
            'This item exists in our search term list, so we should unhide it
            'Note that IF this item is a date but the PivotField format is NOT a date format,
            ' we can't programatically hide/show items, so we'll have to check this first
            If Not bDateFormat Then
                If Not IsNumeric(pi.Value) Then
                    'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
                    If IsDate(pi.Value) Then
                        If Not bDateWarning Then
                            On Error GoTo ErrHandler
                            Err.Raise Number:=997, Description:="Can't filter dates"
                            On Error Resume Next
                        End If
                    Else: pi.Visible = True
                    End If
                Else: pi.Visible = True
                End If
            Else: pi.Visible = True
            End If
        End If
        Err.Clear
    Next
End With

 
Pete commented Another user might want to filter to exclude records listed in an external range. Damn users. Bane of my life. Ah well…I thought I’d have a crack at rewriting the routine to do such exclusions. I was really surprised by how easy it was.

For implementing an inverse filter, I added an optional bInverse argument to the function, with a default value of False. In the case that the function is called with that argument being TRUE, I need the revised code to dynamically change this line:

If Err.Number <> 0 Then

…to this:

If Err.Number = 0 Then

Using an If or Select Case construct is one way you could do this:

With dic
    For Each pi In pfOriginal.PivotItems
        dic.Add pi.Value, 1 'The 1 does nothing
        If bInverse Then
            If Err.Number <> 0 Then
                'This item exists in our search term list, so we should unhide it
                'Note that IF this item is a date but the PivotField format is NOT a date format,
                ' we can't programatically hide/show items, so we'll have to check this first
                If Not bDateFormat Then
                    If Not IsNumeric(pi.Value) Then
                        'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
                        If IsDate(pi.Value) Then
                            If Not bDateWarning Then
                                On Error GoTo ErrHandler
                                Err.Raise Number:=997, Description:="Can't filter dates"
                                On Error Resume Next
                            End If
                        Else: pi.Visible = True
                        End If
                    Else: pi.Visible = True
                    End If
                Else: pi.Visible = True
                End If
            End If
        Else:
            If Err.Number = 0 Then
                'This item exists in our search term list, so we should unhide it
                'Note that IF this item is a date but the PivotField format is NOT a date format,
                ' we can't programatically hide/show items, so we'll have to check this first
                If Not bDateFormat Then
                    If Not IsNumeric(pi.Value) Then
                        'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
                        If IsDate(pi.Value) Then
                            If Not bDateWarning Then
                                On Error GoTo ErrHandler
                                Err.Raise Number:=997, Description:="Can't filter dates"
                                On Error Resume Next
                            End If
                        Else: pi.Visible = True
                        End If
                    Else: pi.Visible = True
                    End If
                Else: pi.Visible = True
                End If
            End If
        End If
        Err.Clear
    Next
End With

…but that seems like overkill, because the only line we want to conditionally change is that If Err.Number <> 0 Then line. The rest of the block is just fine the way it is.

So how to conditionally change just that one line? Like this:

If Err.Number <> 0 = Not bInverse Then

Boy, that was simple. Adding the 2nd logical effectively flips the If Err.Number <> 0 bit to If Err.Number = 0 in the case that bInverse is TRUE.

It works a treat: I tested it on a Pivot containing the things I’m willing to buy the kids for Christmas, and an external list of things containing the presents that the kids actually want. Suffice to say I set bInverse to TRUE, and saved myself a small fortune in a few milliseconds.

And there’s your Christmas tip. Ho ho horrible, I know.

Here’s the whole amended routine:

Sub FilterPivot_ShowItems()
FilterPivot
End Sub

Sub FilterPivot_HideItems()
FilterPivot bInverse:=True
End Sub

Private Function FilterPivot(Optional rngPivotField As Range, Optional rngFilterItems As Range, Optional bInverse As Boolean = False) As Boolean
' Copyright ©2013 Jeff Weir
' weir.jeff@gmail.com
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' ---------------------------------------------------------------------

'   Date        Initial     Details                 Version
'   20131113    JSW         Initial Programming     007 (of course)
'   20131203    JSW         Added Inverse Option    008
 
'#############
'#  Remarks  #
'#############

'   This code needs to be called by a wrapper function.
'   e.g.

'   Sub FilterPivot_ShowItems()
'    FilterPivot
'    End Sub

'    Sub FilterPivot_HideItems()
'    FilterPivot bInverse:=True
'    End Sub

'   If required, that wrapper function can also provide ranges
'   specifying what PivotField to filter, and where the range of
'   filter terms is. e.g.:
'       FilterPivot Range("A2"), Range("C2:C20000")
'   ...or
'       FilterPivot ActiveCell, [tblFilterItems]



    Dim ptOriginal As PivotTable
    Dim ptTemp As PivotTable
    Dim pfOriginal As PivotField
    Dim pfTemp As PivotField
    Dim pfFilterItems As PivotField
    Dim lngFilterItems As Long
    Dim pi As PivotItem
    Dim sc As SlicerCache
    Dim ptFilterItems As PivotTable
    Dim wksTemp As Worksheet
    Dim wksPivot As Worksheet
    Dim dic As Object
    Dim varContinue As Variant
    Dim strMessage As String
    Dim varFormat As Variant
    Dim bDateFormat As Boolean
    Dim bDateWarning As Boolean
    Dim bFirstItemVisible As Boolean
    Dim varFirstItemVisible As Variant

   
   
    FilterPivot = False   'Assume failure

    On Error GoTo ErrHandler
    Set wksPivot = ActiveSheet

    'If neccessary, prompt user for the pivotfield of interest
    If rngPivotField Is Nothing Then
        On Error Resume Next
        Set rngPivotField = ActiveCell
        Set pfOriginal = rngPivotField.PivotField    'Tests if this is in fact a PivotField
        If Err <> 0 Then
            Err.Clear
            Set rngPivotField = Nothing
            Set rngPivotField = Application.InputBox( _
                                Title:="Where is the PivotField?", _
                                Prompt:="Please select a cell in the PivotField you want to filter", _
                                Type:=8)
            On Error GoTo ErrHandler
            If rngPivotField Is Nothing Then Err.Raise 996
        End If
        On Error GoTo ErrHandler
    End If

    Set pfOriginal = rngPivotField.PivotField
    Set ptOriginal = pfOriginal.Parent


    'If neccessary, prompt user for FilterItems table related to the pivotfield of interest
    If rngFilterItems Is Nothing Then
        On Error Resume Next
        Set rngFilterItems = Application.InputBox( _
                             Title:="Where are the filter items?", _
                             Prompt:="Please select the range where your filter terms are", _
                             Type:=8)
        On Error GoTo ErrHandler
        If rngFilterItems Is Nothing Then Err.Raise 996
    End If

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    ' Excel stores dates differently between PivotItems and Variant Arrays.
   
    ' For instance:
    '    ? CStr(varFilterItems(i, 1))
    '    1/01/2013
    '    ? pi.Value
    '    1/1/2013
    '    ? CStr(varFilterItems(i, 1)) = pi.Value
    '    False

    'So we 'll turn our FilterItems into a PivotTable to ensure formats are treated the same.

    Set wksTemp = Sheets.Add
    rngFilterItems.Copy wksTemp.Range("A2")
    wksTemp.Range("A1").Value = "FilterItems"
    Set rngFilterItems = wksTemp.Range("A2").CurrentRegion
   
    On Error GoTo ErrHandler

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rngFilterItems).CreatePivotTable _
        TableDestination:=[C1], TableName:="appFilterItems"
         
    Set ptFilterItems = wksTemp.PivotTables("appFilterItems")
    Set pfFilterItems = ptFilterItems.PivotFields(1)

     ' Add FILTERItems to a Dictionary
    Set dic = CreateObject("scripting.dictionary")
    For Each pi In pfFilterItems.PivotItems
        dic.Add pi.Value, 1 'The one does nothing
    Next

   ptOriginal.ManualUpdate = True  'dramatically speeds up the routine, because the pivot won't recalculate until we're done

       
    'Check if PFOriginal is formatted as a date field.
    ' Basically there is a bug in Excel whereby if you try to do some things
    ' to a PivotItem containing a date but the PivotField number format is NOT a date format
    ' then you get an error.
    ' So we'll check the PivotField date format and see what it is
    ' Note that if a PivotField is based on a range that contains multiple formats
    ' then you get an error simply by checking what the PivotField number format is.
    ' So we'll instigate an On Error Resume Next to handle this
   
    On Error Resume Next
    varFormat = pfOriginal.NumberFormat
    On Error GoTo ErrHandler
    If IsDate(Format(1, varFormat)) Then bDateFormat = True
   
    If bInverse Then
        lngFilterItems = pfOriginal.PivotItems.Count - rngFilterItems.Count
    Else: lngFilterItems = rngFilterItems.Count
    End If
   
    Select Case lngFilterItems / pfOriginal.PivotItems.Count

    Case Is < 0.5
        ' If it's likely that less than half of the source Pivot Field's
        ' items will be visible when we're done, then it will be quickest to hide all but one
        ' item and then unhide the PivotItems that match the filter terms

        ' Iterating through a large pivot setting all but one item to hidden is slow.
        ' And there's no way to directly do this except in Page Fields, and
        ' that method doesn't let you select multiple items anyway.
        ' Plus, as soon as you drag a page field with just one item showing to
        ' a row field, Excel clears the filter, so that all items are visible again.

        ' So we'll use a trick:
        '  *  make the pf of interest in ptTemp a page field
        '  *  turn off multiple items and select just one PivotItem
        '  *  connect it to the original pivot with a slicer
        ' This will very quickly sync up the field on the original pivot so that only one field is showing.
        ' NOTE: If a PivotField has a non-Date format, but contains dates, then
        ' we can't programatically hide/show items. So we need to check for this.

        'Identify a suitable field with which to filter the original PivotTable with
        ' As per note above,
        '  *  If the PivotField format is NOT a date format,
        '     then we need to make sure that this first item is NOT a date.
        '     ...because otherwise we can't address it by VBA
        '  *  If the PivotFied format IS a date format, then just use the first item.
        '  *  We'll write that item to a range, then to a variant, so that Excel applies the
        '     same format to it as it does to items in our Filter list
        If Not bDateFormat Then
            For Each pi In pfOriginal.PivotItems
                If IsDate(pi.Value) Then
                    If IsNumeric(pi.Value) Then
                        'We need the IsNumeric bit above because
                        'VBA thinks that some decimals encased in strings e.g. "1.1" are dates
                        'So we need to check whether this is a decimal and NOT a date
                        varFirstItemVisible = pi.Value
                        Exit For
                    Else:
                        If Not bDateWarning Then
                            Err.Raise Number:=997, Description:="Can't filter dates"
                        End If
                    End If
                Else:
                    varFirstItemVisible = pi.Value
                    Exit For
                End If
            Next
        Else:
            varFirstItemVisible = pfOriginal.PivotItems(1).Value
        End If
       
        Set ptTemp = ptOriginal.PivotCache.CreatePivotTable(TableDestination:=wksTemp.Range("F1"))
        Set pfTemp = ptTemp.PivotFields(pfOriginal.Name)
       
        With pfTemp
            .Orientation = xlPageField
            .ClearAllFilters
            .EnableMultiplePageItems = False
            .CurrentPage = pfTemp.PivotItems(varFirstItemVisible).Value
        End With

        Set sc = ActiveWorkbook.SlicerCaches.Add(ptTemp, pfTemp)
        sc.PivotTables.AddPivotTable ptOriginal
        'Great, our original pivot now just has one item visible in the field of interest
        'So we can delete the slicer connection
        sc.PivotTables.RemovePivotTable ptOriginal

        ' Check if FirstItemVisible should be visible or hidden when we are done
       If dic.exists(varFirstItemVisible) Then bFirstItemVisible = True

       
        ' Now try and add the PivotItems.
        ' If ther's an error, we'll know that this item is also in the FilterTerms
        On Error Resume Next
        With dic
            For Each pi In pfOriginal.PivotItems
                dic.Add pi.Value, 1 'The 1 does nothing
                If Err.Number <> 0 = Not bInverse Then
                    'The Not bInverse bit effectively 'flips' the test "If Err.Number <> 0" to "If Err.Number = 0"
                    'in the case that bInverse argument is TRUE (meaning we want the Pivot to be filtered on things
                    ' NOT in the list of search terms)
           
                    'This item exists in our search term list, so we should unhide it
                    'Note that IF this item is a date but the PivotField format is NOT a date format,
                    ' we can't programatically hide/show items, so we'll have to check this first
                    If Not bDateFormat Then
                        If Not IsNumeric(pi.Value) Then
                            'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
                            If IsDate(pi.Value) Then
                                If Not bDateWarning Then
                                    On Error GoTo ErrHandler
                                    Err.Raise Number:=997, Description:="Can't filter dates"
                                    On Error Resume Next
                                End If
                            Else: pi.Visible = True
                            End If
                        Else: pi.Visible = True
                        End If
                    Else: pi.Visible = True
                    End If
                End If
                Err.Clear
 
            Next
        End With

        If Not bFirstItemVisible = Not bInverse Then
            pfOriginal.PivotItems(varFirstItemVisible).Visible = False
            If Err.Number <> 0 Then
                MsgBox "None of the filter items were found in the Pivot"
                pfOriginal.ClearAllFilters
                Err.Clear
            End If
        End If

    Case Else:
        ' If it's likely that MORE than half of the source Pivot Field's
        ' items will be visible when we're done, then it will be quickest
        ' to unhide all PivotItems and then hide the PivotItems that
        ' DON'T match the filter terms
        pfOriginal.ClearAllFilters

        ' Now try and add the PivotItems.
        ' If there's an error, we'll know that this item is in the FilterItems
        ' Otherwise we'll hide it
       
        On Error Resume Next
        With dic
            For Each pi In pfOriginal.PivotItems
                dic.Add pi.Value, 1 'The 1 does nothing
                If Err.Number = 0 = Not bInverse Then
                    'The Not bInverse bit effectively 'flips' the test "If Err.Number = 0" to "If Err.Number <> 0"
                    'in the case that bInverse argument is TRUE (meaning we want the Pivot to be filtered on things
                    ' NOT in the list of search terms)
                   
                    'This PivotItem NOT in FilterItems list. So hide it
                    'Note that IF this item is a date but the PivotField format is NOT a date format,
                    ' then we can't programatically hide/show items, so we'll have to check this first
                    If Not bDateFormat Then
                        If Not IsNumeric(pi.Value) Then
                            'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates
                            If IsDate(pi.Value) Then
                                If Not bDateWarning Then
                                    On Error GoTo ErrHandler
                                    Err.Raise Number:=997, Description:="Can't filter dates"
                                    On Error Resume Next
                                End If
                            Else: pi.Visible = False 'This item does not exist in the FilterItems. So hide it
                            End If
                        Else: pi.Visible = False 'This item does not exist in the FilterItems. So hide it
                        End If
                    Else: pi.Visible = False
                    End If
                End If
                Err.Clear
            Next
        End With
    End Select
    On Error GoTo ErrHandler
    FilterPivot = True

ErrHandler:
    If Err.Number <> 0 Then
        Select Case Err.Number
        Case Is = 0:    'No error - do nothing
        Case Is = 996:    'Operation Cancelled
        Case Is = 997:    'Can't filter dates
            strMessage = "*** WARNING...I can't correctly filter dates in this Pivot ***"
            strMessage = strMessage & vbNewLine & vbNewLine
            strMessage = strMessage & "I've found at least one date in this PivotField. "
            strMessage = strMessage & "Unfortunately due to a bug in Excel, if you have dates "
            strMessage = strMessage & " in a PivotField AND that PivotField is NOT formatted "
            strMessage = strMessage & " with a date format, then dates "
            strMessage = strMessage & " can't be programatically filtered either in or out. "
            strMessage = strMessage & vbNewLine & vbNewLine
            strMessage = strMessage & " So you'll have to manually check to see whether "
            strMessage = strMessage & " date items appear as they should."
            strMessage = strMessage & vbNewLine & vbNewLine
            strMessage = strMessage & "Do you want me to continue anyway? "
            varContinue = MsgBox(Prompt:=strMessage, Buttons:=vbYesNo, Title:="Sorry, can't filter dates")
            If varContinue = 6 Then
                bDateWarning = True
                Resume Next
            Else: pfOriginal.ClearAllFilters
            End If
        Case Is = 998:    'Can't filter Datafields
            MsgBox "Oops, you can't filter a DataField." & vbNewLine & vbNewLine & "Please select a RowField, ColumnField, or PageField and try again.", vbCritical, "Can't filter Datafields"
        Case Is = 999:    'no pivotfield selected
            MsgBox "Oops, you haven't selected a pivotfield." & vbNewLine & vbNewLine & "Please select a RowField, ColumnField, or PageField and try again.", vbCritical, "No PivotField selected"
        Case Else:
            MsgBox "Whoops, something went wrong"
        End Select
    End If

    With Application
        If Not wksTemp Is Nothing Then
            .DisplayAlerts = False
            wksTemp.Delete
            .DisplayAlerts = True
        End If
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    If Not ptOriginal Is Nothing Then ptOriginal.ManualUpdate = False

End Function

3 Comments

  1. ross says:

    That is the longest code listing I have ever seen!

  2. Jeff Weir says:

    Yep. But I think you’ll find that where filtering pivots robustly is concerned, it’s also the fastest code you’ve ever seen.

  3. Ross says:

    Jeff…of that I have no doubt!

Posting code or formulas in your comment? Use <code> tags!

  • <code lang="vb">Block of code goes here</code>
  • <code lang="vb" inline="true">Inline code goes here</code>
  • <code>Formula goes here</code>

Leave a Reply

Here's how to update your reports of company and nearly any web data: