This post demonstrates how to use VBA to alter the filters on a pivot table based on the values in another pivot table or list.

I have two pivot tables that reveal detail about the costing of clinical services. Both pivot tables are based on different data sources but have a relationship that I want to explore.

The VBA script allows me to amend the filters on the second pivot table so they match the output from the first pivot table.

The first pivot table shows PTS (Patient Treatment Service) cost centre values for a selected clinical specialty And The second pivot table shows the value and origin of the overheads already absorbed in the first table.

As I alter the selected specialty the PTS cost centres and values change and if I then run the VBA script I can get it to amend the filter on the second pivot table to match the cost centres shown in the results of the first.

The VBA below works by initially clearing all the filters on PivotTable 2 and then working through each pivot item and setting its visibility to True or False based on whether the value is included in the Column “B:B”. Column B:B happens to coincide with the cost centre ouput from my first pivot table. So it’s a bit of a cheat, I’ve effectively altered the filters on PivotTable2 based on a range of values or a list rather than specifying a pivot table output but the results are the same.

Here’s the filter pivot table vb.

Sub Pivot_Filter()
 
'Filter Pivot Table vba Macro
 
'Written by Dr Moxie with much assistance from:
'Andrew Poulson http://www.mrexcel.com/forum/excel-questions/745196-filter-pivot-table-based-upon-list-using-visual-basic-applications.html
'and
'http://stackoverflow.com/questions/11468705/unable-to-set-the-visible-property-of-the-pivotitem-class-vba
 
Application.ScreenUpdating = False
 
    Dim PI As PivotItem
 
    With Worksheets("Summary").PivotTables("PivotTable2").PivotFields("OrgUnit Code:")
        .ClearAllFilters
 
        'Refreshing pivot table seems to remove the "set visible property" error
        Worksheets("Summary").PivotTables("PivotTable2").RefreshTable
 
        For Each PI In .PivotItems
            PI.Visible = WorksheetFunction.CountIf(Range("b:b"), PI.Name) > 0
        Next PI
 
    End With
 
        Worksheets("Summary").PivotTables("PivotTable1").RefreshTable
 
End Sub