ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Link Pivot Tables on one filter (https://www.excelbanter.com/excel-discussion-misc-queries/263574-link-pivot-tables-one-filter.html)

steplawn

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


ozgrid.com

Link Pivot Tables on one filter
 
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



Roger Govier[_8_]

Link Pivot Tables on one filter
 
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

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






All times are GMT +1. The time now is 12:48 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com