Update two filters in two pivot tables based on two cell values in Excel

Question

I'm trying to filter two filters in two pivot tables based on two cells. The idea is that the user input information in two cells and these two pivots will update automatically (both filters).

I'm using this code which work for updating only one filter in each pivot table:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next

If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Material")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Material")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub

However, I have the cell d3 that I want to use as well for the second filter.

I tried the following but it is not working, only updates the first filter:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next

If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Material")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Material")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If Intersect(Target, Range("d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Resource")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If Intersect(Target, Range("d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Resource")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub

Is there anything I might be missing? I'm very new with VBA

Thank you in advance for your help.

Hello, I figured this out, please see below:

Private Sub Worksheet_Change(ByVal Target As Range) 'Update by Extendoffice 20180702 Dim xPTable As PivotTable Dim xPFile As PivotField Dim xStr As String On Error Resume Next

If Intersect(Target, Range("d2:d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Material")
xStr = Range("d2").Value
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If Intersect(Target, Range("d2:d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Material")
xStr = Range("d2").Value
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If Intersect(Target, Range("d2:d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Standard")
Set xPFile = xPTable.PivotFields("Resource")
xStr = Range("d3").Value
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

If Intersect(Target, Range("d2:d3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Scenarios").PivotTables("Tasks")
Set xPFile = xPTable.PivotFields("Resource")
xStr = Range("d3").Value
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub

Well of course. `If Intersect(Target, Range("d2")) Is Nothing Then Exit Sub` aborts the rest of the code if you aren't currently changing the first filter (cell d2). — Mark Balhoff, Jul 18 '19 at 20:05
Hi, that's a good point. So how do you recommend I change this code so it filters the pivot using D3 cell as well? — Victoria Pastrán, Jul 19 '19 at 14:58
if Possible, you can use a slicer that connects to both of the pivot tables instead of filters — Ritika, Jul 30 '19 at 04:12

Update two filters in two pivot tables based on two cell values in Excel

0 Answers0