Use drop down list from cells as report filter for multiple Pivot tables in same worksheet using VBA MACRO

[Akshay_Sharma4110]

Hi All,

Please note:- I know about slicer but don't want to use and wants a vba macro only. Below is my query

I've 3 pivot tables in same excel worksheet. All 3 pivot tables have 5 report filters and out of them 4 report filters are common. I want to use a drop down list from cell b4, b5, b6 and b7 having the values of those report filters in them and refresh/update all the 3 pivot tables based on the values selected in the drop down of those cells.
I have created drop downs in those cells using data validation and has linked them the pivot tables but somehow getting error after the 1st & 2nd filter gets applied on pivot. I've highlighted the line from where the code stops executing and it gives run-time error 1004. Below is my code, please help me with the same.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, it only updates when cell B4 to B7 is touched


If Intersect(Target, Range("B4:C7")) Is Nothing Then Exit Sub


''Set the Variables to be used
Dim pt As PivotTable
Dim pt6 As PivotTable
Dim pt1 As PivotTable
Dim FieldBusiness As PivotField
Dim FieldSOURCE_TYPE As PivotField
Dim FieldTIER As PivotField
Dim FieldLoan_Type As PivotField
Dim NewBusiness As String
Dim NewSOURCE_TYPE As String
Dim NewTIER As String
Dim NewLoan_Type As String


'Amend here to filter your data


Set pt = Worksheets("Summary").PivotTables("PivotTable3")
Set pt6 = Worksheets("Summary").PivotTables("PivotTable6")
Set pt1 = Worksheets("Summary").PivotTables("PivotTable1")


Set FieldBusiness = pt.PivotFields("Business")
Set FieldSOURCE_TYPE = pt.PivotFields("SOURCE_TYPE")
Set FieldTIER = pt.PivotFields("TIER")
Set FieldLoan_Type = pt.PivotFields("Loan Type")


NewBusiness = Worksheets("Summary").Range("B4").Value
NewSOURCE_TYPE = Worksheets("Summary").Range("B5").Value
NewTIER = Worksheets("Summary").Range("B6").Value
NewLoan_Type = Worksheets("Summary").Range("B7").Value


'This updates and refreshes the PIVOT table

With pt
FieldBusiness.ClearAllFilters
FieldBusiness.CurrentPage = NewBusiness
FieldSOURCE_TYPE.ClearAllFilters
FieldSOURCE_TYPE.CurrentPage = NewSOURCE_TYPE
FieldTIER.ClearAllFilters
[COLOR=#ff0000]FieldTIER.CurrentPage = NewTIER[/COLOR]
FieldLoan_Type.ClearAllFilters
FieldLoan_Type.CurrentPage = NewLoan_Type
pt.RefreshTable
End With


With pt6
FieldBusiness.ClearAllFilters
FieldSOURCE_TYPE.ClearAllFilters
FieldTIER.ClearAllFilters
FieldLoan_Type.ClearAllFilters
FieldBusiness.CurrentPage = NewBusiness
FieldSOURCE_TYPE.CurrentPage = NewSOURCE_TYPE
FieldTIER.CurrentPage = NewTIER
FieldLoan_Type.CurrentPage = NewLoan_Type
pt.RefreshTable
End With


With pt1
FieldBusiness.ClearAllFilters
FieldSOURCE_TYPE.ClearAllFilters
FieldTIER.ClearAllFilters
FieldLoan_Type.ClearAllFilters
FieldBusiness.CurrentPage = NewBusiness
FieldSOURCE_TYPE.CurrentPage = NewSOURCE_TYPE
FieldTIER.CurrentPage = NewTIER
FieldLoan_Type.CurrentPage = NewLoan_Type
pt.RefreshTable
End With


End Sub

Regards,
Akshay Sharma

 

[Akshay_Sharma4110]

Hi All,

I was able to solve my purpose using the following code. But please let me know what more can be done to make it more effective and small.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim pt As PivotTable
    Const strField1 As String = "Business"
    Const strField2 As String = "SOURCE_TYPE"
    Const strField3 As String = "TIER"
    Const strField4 As String = "Loan Type"


    On Error Resume Next
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    If Target.Address = "$B$4" Then
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField1)
                    .ClearAllFilters
                    .CurrentPage = Target.Value
                End With
            Next pt
        Next ws
    End If
    
    If Target.Address = "$B$5" Then
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField2)
                    .ClearAllFilters
                    .CurrentPage = Target.Value
                End With
            Next pt
        Next ws
    End If
    
    If Target.Address = "$B$6" Then
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField3)
                    .ClearAllFilters
                    .CurrentPage = Target.Value
                End With
            Next pt
        Next ws
    End If
    
    If Target.Address = "$B$7" Then
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField4)
                    .ClearAllFilters
                    .CurrentPage = Target.Value
                End With
            Next pt
        Next ws
    End If
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
End Sub

Regards,
Akshay Sharma