Control Pivot Table Filters Using VBA

Control Pivot Table Filters Using VBA

Paste below code in the Worksheet Code Module

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim str_Location As String, str_Region As String

If Application.Intersect(Target, Range("B1:C2")) Is Nothing Then Exit Sub

'MsgBox "Yes, it intersect."

If Sheet1.Range("B1").Value <> "Location" Then

    Sheet1.Range("B1").Value = "Location"

End If

If Sheet1.Range("C1").Value <> "Region" Then

    Sheet1.Range("C1").Value = "Region"

End If

str_Location = Sheet1.Range("B2").Value

str_Region = Sheet1.Range("C2").Value


If str_Location <> "All" Then

    Sheet2.PivotTables("ThisPivotTable1").PivotFields("Location").ClearAllFilters

    Sheet2.PivotTables("ThisPivotTable1").PivotFields("Location").CurrentPage = str_Location

End If

If str_Region <> "All" Then

    Sheet2.PivotTables("ThisPivotTable1").PivotFields("Region").ClearAllFilters

    Sheet2.PivotTables("ThisPivotTable1").PivotFields("Region").CurrentPage = str_Region

End If

If str_Location = "All" Then

    Sheet2.PivotTables("ThisPivotTable1").PivotFields("Location").ClearAllFilters

End If

If str_Region = "All" Then

    Sheet2.PivotTables("ThisPivotTable1").PivotFields("Region").ClearAllFilters

End If

End Sub

Comments

Popular posts from this blog

Power Automate - Automatically fetch data from Power BI in to Excel and Send the copy of the Excel file via Email

Function to Paste Excel Range on Outlook Mail Body (In text not image) Function Name - rngHTML()

Separate Text (Characters) & Numbers from Alpha Numeric String Using Formula and Macro (VBA)