Control Pivot Table Slicers Using VBA

Control Pivot Table Slicers Using VBA

Paste below code in the Worksheet Code Module

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

'Variables to store drop down values

Dim str_Location As String, str_Region As String

Dim sli As SlicerItem

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

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").Slicers("Location").SlicerCache.ClearAllFilters

End If

If str_Region = "All" Then

    Sheet2.PivotTables("ThisPivotTable1").Slicers("Region").SlicerCache.ClearAllFilters

End If

If str_Location <> "All" Then

    For Each sli In Sheet2.PivotTables("ThisPivotTable1").Slicers("Location").SlicerCache.SlicerItems

        If sli.Name = str_Location Then

            sli.Selected = True

        Else

            sli.Selected = False

        End If

    Next sli

End If

If str_Region <> "All" Then

    For Each sli In Sheet2.PivotTables("ThisPivotTable1").Slicers("Region").SlicerCache.SlicerItems

        If sli.Name = str_Region Then

            sli.Selected = True

        Else

            sli.Selected = False

        End If

    Next sli

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)