VBA to control multiple pivot tables

Harvey12

Board Regular
Joined
Feb 23, 2015
Messages
130
Hi All,

Recently I was looking for a macro to control all of the pivot tables in my workbook to update all of the monthly dates in one go rather than one at a time. I currently use this macro:
Code:
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
On Error Resume Next
Dim wsMain As Worksheet
Dim ws As Worksheet
Dim wsPTF As Worksheet
Dim ptMain As PivotTable
Dim ptF As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField
Dim pf As PivotField
Dim pfPTF As PivotField
Dim pi As PivotItem
Dim bMI As Boolean
Dim bPTF As Boolean


On Error Resume Next
Set wsMain = ActiveSheet
If wsMain.Name <> Me.Name Then GoTo exitHandler
Set wsPTF = Sheets("Change Month")
Set ptMain = Target
Set ptF = wsPTF.PivotTables("PT_List")


Application.EnableEvents = False
Application.ScreenUpdating = False


For Each pfMain In ptMain.PageFields
    bMI = pfMain.EnableMultiplePageItems
    bPTF = False
    For Each pfPTF In ptF.PageFields
      If pfMain.Name = pfPTF.Name Then
        bPTF = True
        Exit For
      End If
    Next pfPTF
    If bPTF = False Then
      Exit For
    End If
    For Each ws In ThisWorkbook.Worksheets
        For Each pt In ws.PivotTables
            If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then
                pt.ManualUpdate = True
                Set pf = pt.PivotFields(pfMain.Name)
                        bMI = pfMain.EnableMultiplePageItems
                        With pf
                            .ClearAllFilters
                            Select Case bMI
                                Case False
                                    .CurrentPage = pfMain.CurrentPage.Value
                                Case True
                                    .CurrentPage = "(All)"
                                    For Each pi In pfMain.PivotItems
                                        .PivotItems(pi.Name).Visible = pi.Visible
                                    Next pi
                                    .EnableMultiplePageItems = bMI
                            End Select
                        End With
                        bMI = False
                
                Set pf = Nothing
                pt.ManualUpdate = False
            End If
        Next pt
    Next ws
Next pfMain
    
exitHandler:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Exit Sub
errHandler:
  MsgBox "Could not update all pivot tables"
  Resume exitHandler


End Sub
Which works exactly as I need it too! But just to throw a curve ball in there my manager has asked that I add in some pivot tables that show the rolling 12 months, which essentially means there are 3 pivot tables, on each tab, that now need to be excluded from the macro. Is there a way to do this? Perhaps excluding all those pivots with the same name? or excluding pivots with names X, Y and Z? Or perhaps since each tab is set up in the same format could it be that any pivot table beyond column 'U' is exempt from the macro?

I'm not sure how to deal with this issue in any way but those were just a few ideas I had?

Can someone please assist! Is this actually possible?

Many thanks
Harvey :
 
Last edited by a moderator:

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
You could add something like:

Code:
If Target.Tablerange1.Column >= 21 Then Exit Sub ' column 21 is column U
 
Upvote 0
Hi Rory,

Thanks for getting back to me, where abouts in the code would you add this in?

Just to the end?
 
Upvote 0
Ignore that - I misread the code. Try this:
Code:
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    On Error Resume Next
    Dim wsMain                As Worksheet
    Dim ws                    As Worksheet
    Dim wsPTF                 As Worksheet
    Dim ptMain                As PivotTable
    Dim ptF                   As PivotTable
    Dim pt                    As PivotTable
    Dim pfMain                As PivotField
    Dim pf                    As PivotField
    Dim pfPTF                 As PivotField
    Dim pi                    As PivotItem
    Dim bMI                   As Boolean
    Dim bPTF                  As Boolean


    On Error Resume Next
    Set wsMain = ActiveSheet
    If wsMain.Name <> Me.Name Then GoTo exitHandler
    Set wsPTF = Sheets("Change Month")
    Set ptMain = Target
    Set ptF = wsPTF.PivotTables("PT_List")


    Application.EnableEvents = False
    Application.ScreenUpdating = False


    For Each pfMain In ptMain.PageFields
        bMI = pfMain.EnableMultiplePageItems
        bPTF = False
        For Each pfPTF In ptF.PageFields
            If pfMain.Name = pfPTF.Name Then
                bPTF = True
                Exit For
            End If
        Next pfPTF
        If bPTF = False Then
            Exit For
        End If
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                If pt.TableRange1.Column < 21 Then    ' column 21 is column U
                    If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then
                        pt.ManualUpdate = True
                        Set pf = pt.PivotFields(pfMain.Name)
                        bMI = pfMain.EnableMultiplePageItems
                        With pf
                            .ClearAllFilters
                            Select Case bMI
                                Case False
                                    .CurrentPage = pfMain.CurrentPage.Value
                                Case True
                                    .CurrentPage = "(All)"
                                    For Each pi In pfMain.PivotItems
                                        .PivotItems(pi.Name).Visible = pi.Visible
                                    Next pi
                                    .EnableMultiplePageItems = bMI
                            End Select
                        End With
                        bMI = False

                        Set pf = Nothing
                        pt.ManualUpdate = False
                    End If
                End If
            Next pt
        Next ws
    Next pfMain

exitHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
errHandler:
    MsgBox "Could not update all pivot tables"
    Resume exitHandler


End Sub
 
Upvote 0
Hey Rory,

Thanks so much! Ran this macro and it seems to work perfectly! Thanks ever such a lot!

Would I need to set up a separate thread to ask a different question but for the same file?

Many thanks
Harvey
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top