Refresh PivotTables in ActiveSheet by Selection

[dellzy]

Hi Excel Experts,

Can anyone help me to edit this so that it will only refresh on ActiveSheet instead of entire workbook, please?

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

 

[Domenic]

I haven't tested it, but try...

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

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 ptMain = Target

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each pfMain In ptMain.PageFields
    bMI = pfMain.EnableMultiplePageItems
    For Each pt In Me.PivotTables
        If pt.Name <> ptMain.Name 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 pfMain

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Hope this helps!

 

[dellzy]

I haven't tested it, but try...

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

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 ptMain = Target

Application.EnableEvents = False
Application.ScreenUpdating = False

For Each pfMain In ptMain.PageFields
    bMI = pfMain.EnableMultiplePageItems
    For Each pt In Me.PivotTables
        If pt.Name <> ptMain.Name 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 pfMain

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Hope this helps!

Hi Domenic, Awesome! Your my saviour! It works perfectly! Thank you a zillion!

 

[Domenic]

You're very welcome!

And thanks for the feedback!

Cheers!

 

[dellzy]

Hi Excel Experts!

Recently Domenic has helped me the solution for any selection on any filter options. Now I need help as I have a requirement to allow refresh all pivots on same worksheet based on changes on specific filter only. eg. Month

Only when user change the month that all pivots will follow, otherwise other changes on other filters should not impact other pivots.

Here I paste back the code edited by Domenic earlier :-

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Courier; -webkit-text-stroke: #000000}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px Courier; -webkit-text-stroke: #000000; min-height: 14.0px}span.s1 {font-kerning: none}</style>

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)


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 ptMain = Target


Application.EnableEvents = False
Application.ScreenUpdating = False


For Each pfMain In ptMain.PageFields
    bMI = pfMain.EnableMultiplePageItems
    For Each pt In Me.PivotTables
        If pt.Name <> ptMain.Name 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 pfMain


Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub

Thanks in advance.
DZ