Pivot Table Auto Filter base on Cell Value|VBA & Macros|Excel Forum|My Online Training Hub

Hello,

I created a dashboard consisting of multiple pivot tables and slicers in a single sheet.

Then I inserted a VBA to filter pivot tables based on a cells value (top items; top percentage; bottom items; bottom percentage).

Now, I need to add 2 features, if it's possible:

1) I'd like to specify which is (or are) the pivot table (s) that I want to update, through a dropdown menu list.....

So, the selected pivot table (or tables) will update accordingly to the data filter typed (top item, top %, bottom items, bottom %). 

2) Now, the untyped pivot tables should update on the base of the filtered data of typed pivot tables

e.g.

Open the attachment and go to "Sheet2". Then, type Top % 10: you will see all the pivot tables will update accordingly. 

Now, I guess I want to update only "PivotTable2" (this is additional feature #1) 

After that,  I want also all the other PivotTables will update data based on filtered data in "PivotTable2" (this is additional feature #2) 

Any ideas? 

Please see attachment

regards

Mark

VBA CODE:

Option Explicit
'===================================
'MULTI PIVOT VERSION
Private Sub Worksheet_Change _
(ByVal Target As Range)
Dim ws As Worksheet
Dim wsL As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pfD As PivotField
Dim rngType As Range
Dim rngTypeSel As Range
Dim rngNum As Range
Dim lType As Long

On Error GoTo errHandler

Set ws = ActiveSheet
Set wsL = Worksheets("Sheet1")
Set rngType = ws.Range("TypeSel")
Set rngTypeSel _
= wsL.Range("TypeValSel")
Set rngNum = ws.Range("NumSel")

Select Case Target.Address
Case rngType.Address, _
rngNum.Address
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each pt In ws.PivotTables
Set pf = pt.RowFields(1)
Set pfD = pt.DataFields(1)
pf.ClearAllFilters
If rngNum.Value > 0 And _
rngTypeSel > 0 Then
pf.PivotFilters.Add _
Type:=rngTypeSel.Value, _
DataField:=pfD, _
Value1:=rngNum.Value
End If
Next pt

End Select

exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub

errHandler:
MsgBox "Could not apply filter"
Resume exitHandler
End Sub

'===================================
'SINGLE PIVOT VERSION
'---To use this version, comment out
'----MULTI PIVOT VERSION or delete it
'---Then, uncomment this procedure
'----------
'Private Sub Worksheet_Change _
'() ' (ByVal Target As Range)
'Dim ws As Worksheet
'Dim wsL As Worksheet
'Dim pt As PivotTable
'Dim pf As PivotField
'Dim pfD As PivotField
'Dim rngType As Range
'Dim rngTypeSel As Range
'Dim rngNum As Range
'Dim lType As Long
'
'On Error GoTo errHandler
'
'Set ws = ActiveSheet
'Set wsL = Worksheets("Sheet1")
'Set pt = ws.PivotTables("PivotTable1")
'Set pf = pt.RowFields(1)
'Set pfD = pt.DataFields(1)
'Set rngType = ws.Range("TypeSel")
'Set rngTypeSel _
' = wsL.Range("TypeValSel")
'Set rngNum = ws.Range("NumSel")
'
'Select Case Target.Address
' Case rngType.Address, rngNum.Address
' Application.EnableEvents = False
' Application.ScreenUpdating = False
' pf.ClearAllFilters
' If rngNum.Value > 0 And _
' rngTypeSel > 0 Then
' pf.PivotFilters.Add _
' Type:=rngTypeSel.Value, _
' DataField:=pfD, _
' Value1:=rngNum.Value
' End If
'End Select
'
'exitHandler:
' Application.ScreenUpdating = True
' Application.EnableEvents = True
' Exit Sub
'
'errHandler:
' MsgBox "Could not apply filter"
' Resume exitHandler
'End Sub