Select all Pivot Items that match list of items in

Question

I have one Excel sheet that contains a list of people and their associated departments. In a PivotTable on another sheet, I would like to filter my results so that all items "Assigned To" any of the people in a given department will be displayed.

So far, I have code that will filter the list of people to the desired department, and will create an array that contains the names of all of those people. I have then tried to filter the PivotItems that contain these lists of names to be visible and all others to be hidden, but when I try to run the macro it is just continuously thinking. Is there an easier way to do this?

ActiveSheet.Range("$A$1:$E$175").AutoFilter Field:=4, Criteria1:= _
        "DEPARTMENT NAME"

'Selects first visible row of filtered data set & _
 create array that contains all filtered names  
ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(3, 2).Select
employeerange = "C" & ActiveCell.Row & ":C" & ActiveSheet.Rows.Count
Dim employeearray As Variant
employeearray = Range(employeerange).Value

'Cycle through all possible items for the given Pivot Field and compare to _ 
 each of the names in the employee array.  Set items that match to visible _ 
 and all others to hidden.

Dim PI As PivotItem
Dim element As Variant
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("PIVOT FIELD")
        For Each PI In .PivotItems
            For Each element In employeearray
            If PI Like "*" & CStr(element) & "*" Then
                PI.Visible = True
                Else
                PI.Visible = False
            End If
            Next element
        Next PI
    End With

Answer 1

Have you checked the first part of your code that builds the array? I can't see your data but I'm not sure that will work the way you hope.

To build up your array, use something like:

ActiveSheet.Range("$A$1:$E$175").AutoFilter Field:=4, Criteria1:= "DEPARTMENT NAME"
Dim employeearray As Variant
employeearray = ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Columns("C").Value

As for the 2nd part of the macro..

You're over-testing the match, which if you left it to run would hide everything but the last match.

Use the following instead, which loops through all the .PivotItems but uses a single test to check if the item is in the array.

Dim PI As PivotItem
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("PIVOT FIELD")
        For Each PI In .PivotItems
            PI.Visible = (UBound(Filter(employeearray, PI.Name)) > -1)
        Next PI
    End With

Answer 2

When iterating over PivotItems, there's a couple of bottlenecks and gotchas that you want to avoid. See my post at http://dailydoseofexcel.com/archives/2013/11/14/filtering-pivots-based-on-external-ranges/ for more on this.

Among other things, you want to set the PivotTable's ManualUpdate property to TRUE while you do the iteration and then back to FALSE when you're done. Otherwise Excel will try to update the PivotTable each time you change the visibility of a PivotItem. And you also want to ensure that at least one item remains visible at all times. I use something like this:

Option Explicit

Sub FilterPivot()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Long
Dim vItem As Variant
Dim vCountries As Variant

Set pt = ActiveSheet.PivotTables("PivotTable1")
Set pf = pt.PivotFields("CountryName")

vCountries = Array("FRANCE", "BELGIUM", "LUXEMBOURG")

pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed

With pf

    'At least one item must remain visible in the PivotTable at all times, so make the first
    'item visible, and at the end of the routine, check if it actually  *should* be visible        
    .PivotItems(1).Visible = True

    'Hide any other items that aren't already hidden.
    'Note that it is far quicker to check the status than to change it.
    ' So only hide each item if it isn't already hidden
    For i = 2 To .PivotItems.Count
        If .PivotItems(i).Visible Then .PivotItems(i).Visible = False
    Next i

    'Make the PivotItems of interest visible
    On Error Resume Next 'In case one of the items isn't found
    For Each vItem In vCountries
        .PivotItems(vItem).Visible = True
    Next vItem
    On Error GoTo 0

    'Hide the first PivotItem, unless it is one of the countries of interest
    On Error Resume Next
    If InStr(UCase(Join(vCountries, "|")), UCase(.PivotItems(1))) = 0 Then .PivotItems(1).Visible = False
    If Err.Number <> 0 Then
        .ClearAllFilters
        MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Pivot, so I have cleared the filter"
    End If
    On Error GoTo 0

End With

pt.ManualUpdate = False

End Sub