Link Pivot Tables on one filter

I have several pivot tables all on one worksheet and on the same tab. I
have successfully used the below vba code to get the first pivot table
to update based on a non-pivot table cell value. How do I apply the
same code to all of the other pivot tables on the tab? I am brand new
to vba, so I'm not sure how to do an "or" or "in list" type function
that will look at more than just one pivot table. Any help would be
much appreciated!

Thanks


Code:
--------------------

Option Explicit

Const RegionRangeName As String = "RegionFilterRange"
Const PivotTableName As String = "Zoning"
Const PivotFieldName As String = "Region"

Public Sub UpdatePivotFieldFromRange(RangeName As String, FieldName As String, _
PivotTableName As String)

Dim rng As Range
Set rng = Application.Range(RangeName)

Dim pt As PivotTable
Dim Sheet As Worksheet
For Each Sheet In Application.ActiveWorkbook.Worksheets
On Error Resume Next
Set pt = Sheet.PivotTables(PivotTableName)
Next
If pt Is Nothing Then GoTo Ex

On Error GoTo Ex

pt.ManualUpdate = True
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim Field As PivotField
Set Field = pt.PivotFields(FieldName)
Field.ClearAllFilters
Field.EnableItemSelection = False
SelectPivotItem Field, rng.Text
pt.RefreshTable

Ex:
pt.ManualUpdate = False
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Public Sub SelectPivotItem(Field As PivotField, ItemName As String)
Dim Item As PivotItem
For Each Item In Field.PivotItems
Item.Visible = (Item.Caption = ItemName)
Next
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Application.Range(RegionRangeName)) _
Is Nothing Then
UpdatePivotFieldFromRange _
RegionRangeName, PivotFieldName, PivotTableName
End If
End Sub

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




--
steplawn

Sub UpdateAllPivoTables()
Dim pt As PivotTable
Dim WSheet As Worksheet

For Each WSheet In Worksheets
For Each pt In WSheet.PivotTables
'YOUR CODE HERE
Next pt
Next WSheet

End Sub



--
Regards
Dave Hawley
www.ozgrid.com
"steplawn" wrote in message
...

I have several pivot tables all on one worksheet and on the same tab. I
have successfully used the below vba code to get the first pivot table
to update based on a non-pivot table cell value. How do I apply the
same code to all of the other pivot tables on the tab? I am brand new
to vba, so I'm not sure how to do an "or" or "in list" type function
that will look at more than just one pivot table. Any help would be
much appreciated!

Thanks


Code:
--------------------

Option Explicit

Const RegionRangeName As String = "RegionFilterRange"
Const PivotTableName As String = "Zoning"
Const PivotFieldName As String = "Region"

Public Sub UpdatePivotFieldFromRange(RangeName As String, FieldName As
String, _
PivotTableName As String)

Dim rng As Range
Set rng = Application.Range(RangeName)

Dim pt As PivotTable
Dim Sheet As Worksheet
For Each Sheet In Application.ActiveWorkbook.Worksheets
On Error Resume Next
Set pt = Sheet.PivotTables(PivotTableName)
Next
If pt Is Nothing Then GoTo Ex

On Error GoTo Ex

pt.ManualUpdate = True
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim Field As PivotField
Set Field = pt.PivotFields(FieldName)
Field.ClearAllFilters
Field.EnableItemSelection = False
SelectPivotItem Field, rng.Text
pt.RefreshTable

Ex:
pt.ManualUpdate = False
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Public Sub SelectPivotItem(Field As PivotField, ItemName As String)
Dim Item As PivotItem
For Each Item In Field.PivotItems
Item.Visible = (Item.Caption = ItemName)
Next
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
If Not Intersect(Target, Application.Range(RegionRangeName)) _
Is Nothing Then
UpdatePivotFieldFromRange _
RegionRangeName, PivotFieldName, PivotTableName
End If
End Sub

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




--
steplawn

Hi

Since you say that all PT's are on the same tab, you do not need to step
through each sheet in the Workbook

For Each Sheet In Application.ActiveWorkbook.Worksheets

but you do need to step through each PT in the ActiveSheet.

For Each pt In ActiveSheet.PivotTables

--
Regards
Roger Govier

steplawn wrote:
I have several pivot tables all on one worksheet and on the same tab. I
have successfully used the below vba code to get the first pivot table
to update based on a non-pivot table cell value. How do I apply the
same code to all of the other pivot tables on the tab? I am brand new
to vba, so I'm not sure how to do an "or" or "in list" type function
that will look at more than just one pivot table. Any help would be
much appreciated!

Thanks


Code:
--------------------

Option Explicit

Const RegionRangeName As String = "RegionFilterRange"
Const PivotTableName As String = "Zoning"
Const PivotFieldName As String = "Region"

Public Sub UpdatePivotFieldFromRange(RangeName As String, FieldName As String, _
PivotTableName As String)

Dim rng As Range
Set rng = Application.Range(RangeName)

Dim pt As PivotTable
Dim Sheet As Worksheet
For Each Sheet In Application.ActiveWorkbook.Worksheets
On Error Resume Next
Set pt = Sheet.PivotTables(PivotTableName)
Next
If pt Is Nothing Then GoTo Ex

On Error GoTo Ex

pt.ManualUpdate = True
Application.EnableEvents = False
Application.ScreenUpdating = False

Dim Field As PivotField
Set Field = pt.PivotFields(FieldName)
Field.ClearAllFilters
Field.EnableItemSelection = False
SelectPivotItem Field, rng.Text
pt.RefreshTable

Ex:
pt.ManualUpdate = False
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Public Sub SelectPivotItem(Field As PivotField, ItemName As String)
Dim Item As PivotItem
For Each Item In Field.PivotItems
Item.Visible = (Item.Caption = ItemName)
Next
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Application.Range(RegionRangeName)) _
Is Nothing Then
UpdatePivotFieldFromRange _
RegionRangeName, PivotFieldName, PivotTableName
End If
End Sub

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