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
    On Error Goto Handling

    If Intersect(Target, Range("B1")) IsNot Nothing Then
        Application.ScreenUpdating = False
        Set xPTable = Worksheets("Sheet1").PivotTables("Depots")
        if xPTable IsNot Nothing Then
            Set xPFile = xPTable.PivotFields("Depot Filter")
            if xPFile IsNot Nothing then
                xStr = Target.Text
                xPFile.ClearAllFilters
                xPFile.CurrentPage = xStr
            end if
        end if
    end if

    Done:
        Exit Sub
    Handling:
        Application.ScreenUpdating = True
End Sub

HootTheOwl fucked around with this message at 18:44 on Nov 10, 2022

Private Sub Worksheet_Change(ByVal target As Range)
On Error GoTo ErrorHandler

    Const filterCellName As String = "B2"
    Const worksheetName As String = "Sheet1"
    Const pivotTableName As String = "PivotTable1"
    Const pivotFilterFieldName As String = "COL A"
    
    If Not Intersect(target, Range(filterCellName)) Is Nothing Then
        With Worksheets(worksheetName).PivotTables(pivotTableName).PivotFields(pivotFilterFieldName)
            .ClearAllFilters
            .CurrentPage = Range(filterCellName).Value
        End With
    End If
    
    Exit Sub

ErrorHandler:
    'notify users of an error here.

End Sub

• Check if Range(filterCellName).Value = "" and set .CurrentPage to "(All)" instead, otherwise you'll throw an error when you really don't need to.
  
• If you want to update a cell to notify your users you may run into an infinite loop of worksheet_change events. Let us know if this is your plan and we can provide more advice.
  

Only registered members can see post attachments!

Busy Bee fucked around with this message at 15:03 on Jan 5, 2023