Snasui Excel Forum

Code: Select all

Option Explicit

Const RegionRangeName As String = "RegionFilterRange"
Const PivotTableName As String = "PivotTable3"
Const PivotFieldName As String = "Doc_Classification"

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