ExcelBanter - View Single Post

steplawn

I have several pivot tables all on one worksheet and on the same tab. I have successfully used the below vba code to get the first pivot table to update based on a non-pivot table cell value. How do I apply the same code to all of the other pivot tables on the tab? I am brand new to vba, so I'm not sure how to do an "or" or "in list" type function that will look at more than just one pivot table. Any help would be much appreciated!

Thanks

Code:

Option Explicit

Const RegionRangeName As String = "RegionFilterRange"
Const PivotTableName As String = "Zoning"
Const PivotFieldName As String = "Region"

Public Sub UpdatePivotFieldFromRange(RangeName As String, FieldName As String, _
PivotTableName As String)

    Dim rng As Range
    Set rng = Application.Range(RangeName)
    
    Dim pt As PivotTable
    Dim Sheet As Worksheet
    For Each Sheet In Application.ActiveWorkbook.Worksheets
        On Error Resume Next
        Set pt = Sheet.PivotTables(PivotTableName)
    Next
    If pt Is Nothing Then GoTo Ex
    
    On Error GoTo Ex
    
    pt.ManualUpdate = True
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Dim Field As PivotField
    Set Field = pt.PivotFields(FieldName)
    Field.ClearAllFilters
    Field.EnableItemSelection = False
    SelectPivotItem Field, rng.Text
    pt.RefreshTable
    
Ex:
    pt.ManualUpdate = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

Public Sub SelectPivotItem(Field As PivotField, ItemName As String)
    Dim Item As PivotItem
    For Each Item In Field.PivotItems
        Item.Visible = (Item.Caption = ItemName)
    Next
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Intersect(Target, Application.Range(RegionRangeName)) _
        Is Nothing Then
            UpdatePivotFieldFromRange _
            RegionRangeName, PivotFieldName, PivotTableName
    End If
End Sub