Applying filters in pivots using VBA

Hi

If you want to apply filter on pivot fields using vba snapshot below -






Here is the code-

Option Compare Text
Sub filter_pivot()
Application.StatusBar = True
Application.StatusBar = "Please Wait Till Macro Update All The Pivot Tables"
Application.ScreenUpdating = False


Application.EnableEvents = False

Dim pt As PivotTable
'----------------------------- -----------------------
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxx SHEET NAME - PIVOT xxxxxxxxxxxxxxxxxxxxxxx
'----------------------------- -----------------------

' IT WILL APPLY FILTER TO ALL PICOT TABLES ON SHEET PIVOT IF YOU WANT TO AVOID THIS SPECIFY NAME OF PIVOT
Dim pi1, pi2 As PivotItem
For Each pt In Sheets("Pivot").PivotTables
pt.ManualUpdate = True



'+++++++++++++++++++++++++++++++++++++++++++

For Each pi1 In pt.PivotFields("Client").PivotItems
On Error Resume Next
pi1.Visible = True

Next pi1

For Each pi2 In pt.PivotFields("Sub Client").PivotItems
On Error Resume Next
pi2.Visible = True

Next pi2

For Each pi2 In pt.PivotFields("Location").PivotItems
On Error Resume Next
pi2.Visible = True

Next pi2


'++++++++++++++++++++++++++++++++++++++++
' IT WILL APPLY FILTER ON FILEDS IN THIS PART OF CODE

If Sheets("Pivot").Range("h4").Value <> "ALL" Then
For Each pi1 In pt.PivotFields("Client").PivotItems

If pi1.Value = Sheets("Pivot").Range("h4").Value Then
pi1.Visible = True

Else
On Error Resume Next
pi1.Visible = False
End If
Next pi1
End If

If Sheets("Pivot").Range("j4").Value <> "ALL" Then
For Each pi2 In pt.PivotFields("Sub Client").PivotItems
If pi2.Value = Sheets("Pivot").Range("j4").Value Then
pi2.Visible = True

Else
On Error Resume Next
pi2.Visible = False
End If
Next pi2
End If


If Sheets("Pivot").Range("l4").Value <> "ALL" Then
For Each pi2 In pt.PivotFields("Location").PivotItems
If pi2.Value = Sheets("Pivot").Range("L4").Value Then
pi2.Visible = True

Else
On Error Resume Next
pi2.Visible = False
End If
Next pi2
End If
pt.ManualUpdate = False
pt.RefreshTable
Next pt




'----------------------------- The End------------------------


Application.EnableEvents = True

Application.ScreenUpdating = True
Application.StatusBar = False




End Sub



----------------------------------------------------------------------------------------------











Source Files -

http://www.filefactory.com/file/cca0fc3/n/APPLYING_FILTERS_IN_PIVOT_TABLE.xlsm

http://www.4shared.com/folder/N9czEwDM/_online.html