Updating multiple pivot tables at same time.

samait

New member
Joined
Aug 14, 2013
Messages
7
Reaction score
0
Points
0
I'm hoping you can help me. :) I've been trying to figure out what I need to change in the code, but here's the situation - the field I need to change, "Wk Ending" is a column header. When I update it while I have this code, it loses all filters in all the pivot tables on that sheet (I have several filters on each pivot table, with the common filter being the Wk Ending field) Can you help me? Again, this is a column header that is a date, and when I update it, it is usually with me using a date filter similar to After 5/13/19.Hoping you can help. I feel really lost. :) Thank you!

Code:
[COLOR=#000000][FONT=Tahoma]Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
On Error Resume Next
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[/FONT][/COLOR]
[COLOR=#000000][FONT=Tahoma]On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target[/FONT][/COLOR]
[COLOR=#000000][FONT=Tahoma]Application.EnableEvents = False
Application.ScreenUpdating = False[/FONT][/COLOR]
[COLOR=#000000][FONT=Tahoma]'change only Region field for all pivot tables on active sheet[/FONT][/COLOR]
[COLOR=#000000][FONT=Tahoma]Set pfMain = ptMain.PivotFields("Wk Ending")
bMI = pfMain.EnableMultiplePageItems
For Each pt In wsMain.PivotTables
If pt ptMain Then
pt.ManualUpdate = True
Set pf = pt.PivotFields("Wk Ending")
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[/FONT][/COLOR]
[COLOR=#000000][FONT=Tahoma]Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt[/FONT][/COLOR]
[COLOR=#000000][FONT=Tahoma]Application.EnableEvents = True
Application.ScreenUpdating = True[/FONT][/COLOR]
[COLOR=#000000][FONT=Tahoma]End Sub[/FONT][/COLOR]
 
Last edited by a moderator:

Herbds7

Banned
Joined
May 8, 2013
Messages
197
Reaction score
0
Points
0
Nobody can run your code without the underlying source data and spreadsheet.
Upload.
 

samait

New member
Joined
Aug 14, 2013
Messages
7
Reaction score
0
Points
0
oh! Ok. I will upload the file shortly. Thank you.
 

samait

New member
Joined
Aug 14, 2013
Messages
7
Reaction score
0
Points
0
How do I upload the file? I am not able to do attachments yet it seems. :-(
 

JeffreyWeir

Super Moderator
Staff member
Joined
Mar 22, 2011
Messages
357
Reaction score
0
Points
0
Location
New Zealand
Hi Samait. Sorry, I forgot that you wouldn't be able to upload a document here when I directed you to this forum via my comment at the Contextures blog. Another solution for uploading a file is to post a link via Dropbox. Failing that, send it to me at weir.jeff@gmail.com and I'll upload it for you, as well as take a look.
 

samait

New member
Joined
Aug 14, 2013
Messages
7
Reaction score
0
Points
0
thank you. I'll upload shortly. My newest granddaughter was just born, so i've been out of the office. :)
 

WizzardOfOz

New member
Joined
Sep 4, 2013
Messages
184
Reaction score
0
Points
0
Location
Australia
Excel Version(s)
Office 365
I had a similar problem a while back, if I recall the solution was to write all filters to variables then reset and reload. Will try to dig up code if I have time.
 
Top