I am new to this site and a beginner to VBA. I am looking for any insight or advice for a problem trying to sync the filters on multiple pivot tables.
I have two pivot tables from two different data sources. These two pivot tables have the same filters (customer) and I am attempting to sync the filters by using a reference cell that changes when a form control is changed. I use a form control dropdown where I select a customer, then that customer is indexed to my reference cell (N1 on my "Pivots" worksheet). Ultimately, I want the filters on each of my pivot tables to equal the text in cell N1. My code works to change the filters in unison, but my problems begin when I have a certain customer in one dataset but not the other. The code is trying to filter an item that is non-existent in one dataset. I have tried writting error trapping codes, but I cannot figure out how to properly do this, or how to resume my code after the error handler runs without looping back into my error handler. When the selected customer is not an available filter, I have tried to filter for blanks which will result in a zero value.
Any help or suggestions are much appreciated.
Sub DD1126()
Worksheets("Pivots").Select
Dim CustomerIndex As String
Dim PT As PivotTable
Dim n As Long
Dim ptField As PivotField
Dim ErrIndex As String
CustomerIndex = Worksheets("Pivots").Range("N1").Text
ErrIndex = "(blank)"
For n = 1 To 2
Set PT = ActiveSheet.PivotTables("PivotTable" & n)
With PT.PivotFields("Customer")
On Error GoTo ErrHandle
If .Orientation = xlPageField Then
.CurrentPage = ShipToIndex
ElseIf .Orientation = xlRowField Then
PT.ManualUpdate = True
.ClearAllFilters
.PivotFilters.Add xlCaptionEquals, , CustomerIndex
PT.ManualUpdate = False
End If
End With
Next n
ErrHandle:
With PT.PivotFields("Customer")
If .Orientation = xlPageField Then
.CurrentPage = ErrIndex
ElseIf .Orientation = xlRowField Then
PT.ManualUpdate = True
.ClearAllFilters
.PivotFilters.Add xlCaptionEquals, , ErrIndex
PT.ManualUpdate = False
End If
End With
Resume
Worksheets("Spreadsheet").Select
End Sub
Bookmarks