• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Refresh All PivotTables in ActiveSheet by Selection

Dahlia

Member
Dear Excel Experts,

I found this awesome vba to update all pivottables in whole workbook based on selection at the pivotfilters. However, I just need that to happen on ActiveSheet only. And I don't know which part to change/deleted to allow this. I tried tweaking a little bit here and there but it doesn't seem to give me the expected result. Appreciate your expertise to edit accordingly:-

Code:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Dim wsMain As Worksheet
Dim ws As Worksheet
Dim ptMain As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField
Dim pf As PivotField
Dim pi As PivotItem
Dim bMI As Boolean

On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each pfMain In ptMain.PageFields
    bMI = pfMain.EnableMultiplePageItems
    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

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Thank you in advance.
DZ
 
Back
Top