• 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.

Update page field in Multiple Pivot Tables on Multiple Sheets

flyte

flyte

New Member
Hi Everyone and I hope your day is going well,

I have a report that holds around 100 pivot tables on different worksheets. I have coded to refresh all the pivot tables and change the page fields. I know the coding can be better. My way is just too long.

Example:

Code: 
Private Sub ListBox1_Click()
Clear_All_Filters
Worksheets("Summary").Select
Worksheets("Summary").Range("I1").Value = "SELECTION BY HUB NAME"
Worksheets("Summary").Range("I2").Value = Me.ListBox1.Value

'Change Pivot Tables
' Income Management Page Pivot Table (P1  to P4)
MASTwb = ThisWorkbook.Name
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P1").PageFields("Hub Name").CurrentPage = Me.ListBox1.Value
MASTwb = ThisWorkbook.Name
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P2").PageFields("Hub Name").CurrentPage = Me.ListBox1.Value
MASTwb = ThisWorkbook.Name
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P3").PageFields("Hub Name").CurrentPage = Me.ListBox1.Value]

This code is against every page field (there are 5 page fields) against every pivot table in every worksheet(there are 7 Worksheets).

To clear the page fields I have used the following code:
Code: 
Sub Clear_IM_Filters()
'Clear  Pivot Tables - Income Management Sheet
MASTwb = ThisWorkbook.Name
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P1").PageFields("Hub Name").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P1").PageFields("Hub Group").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P1").PageFields("Parent Community").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P1").PageFields("Community").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P1").PageFields("Office").ClearAllFilters
MASTwb = ThisWorkbook.Name
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P2").PageFields("Hub Name").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P2").PageFields("Hub Group").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P2").PageFields("Parent Community").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P2").PageFields("Community").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P2").PageFields("Office").ClearAllFilters

MASTwb = ThisWorkbook.Name
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P3").PageFields("Hub Name").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P3").PageFields("Hub Group").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P3").PageFields("Parent Community").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P3").PageFields("Community").ClearAllFilters
Workbooks(MASTwb).Sheets("Income Management").PivotTables("P3").PageFields("Office").ClearAllFilters
End Sub

Again the code is repeated over and over again against each Pivot table on each worksheet.

I know this is not in a hair's breath of being close to the best way to update multiple pivot tables on multiple worksheets. Can someone please direct me to the best approach?

Any hints and tips would be greatly appreciated. As I have to duplicate this report another 4 times.

Cheers

Tash
 
Thanks for the reply Jeff,

Yep that is what I am after - instant synchronisation. I am using Excel 2010. The various pivot tables run off different external data sources. Can one set of slicers deal with different pivot cache?

I did read your link to daily dose of excel and the example was for pivot tables from a common data source.

Regards

Natasha



jeffreyweir said:
flyte: what version of Excel are you using? If Excel 2010 or later, then instead of using a Listbox to capture the user's selection, just use a Slicer, and connect that Slicer to every pivot. One click, instant syncronisation, no VBA.

Assuming this is what you're trying to ultimately do.

If so, give my post here a read:
http://dailydoseofexcel.com/archives/2014/08/16/sync-pivots-from-dropdown/
Click to expand...
 
How many different data sources are there?

THis code might help you easily work this out. Just put it it a standard module, and run it. It will insert a new sheet with a whole heap of info about your pivots.

Code: 
Sub PivotReport()
'  Desc:  Reports on


'  Programmer:  Jeff Weir
'  Contact:  weir.jeff@gmail.com

'  Name/Version:  Date:  Ini:  Modification:
'  PivotReport V1  20140808  JSW  Original Development
   
'  Inputs:

'  Outputs:
Dim rs As Object 'We're using late binding. If we were using early, we'd use Dim rs ADODB.Recordset
Dim sc As SlicerCache
Dim pt As PivotTable
Dim pc As PivotCache
Dim pf As PivotField
Dim wks As Worksheet
Dim sht As Worksheet
Dim rng As Range
Dim bPivotReportExists As Boolean
Dim bOLAP As Boolean
Dim strFieldtype As String
Dim strFieldName As String


Application.ScreenUpdating = False

Set rs = CreateObject("ADODB.Recordset") 'We're using late binding. If we were using early, we'd use Set rs = New ADODB.Recordset
With rs
  .Fields.Append "Field", adVarChar, 500
  .Fields.Append "Orientation", adVarChar, 50
  .Fields.Append "Sheet", adVarChar, 32 'Sheetnames can only be 32 characters
  .Fields.Append "Pivot", adVarChar, 500
  .Fields.Append "Pivot|Field", adVarChar, 1500
  .Fields.Append "PivotCache", adInteger
  .Fields.Append "SlicerCache", adInteger ', adFldIsNullable = True, adFldMayBeNull = True
  .Fields.Append "SourceType", adVarChar, 200
  .Fields.Append "Source", adVarChar, 5000

  .CursorLocation = adUseClient
  .CursorType = adOpenStatic
  .Open
End With
   
For Each wks In ActiveWorkbook.Worksheets
  If wks.Name <> "PivotReport" Then
  For Each pt In wks.PivotTables
  Set pc = pt.PivotCache
  'First, determine if the Pivot is based on an OLAP cube.
  ' If it is, then we'll want to record the pf.CubeField.Name instead of the pf.Name in the code below
  bOLAP = pt.PivotCache.OLAP

  For Each pf In pt.PivotFields

  If pf.Name <> "Values" Then
  'Record name of PivotField.
  ' (If pt based on OLAP, we want to record pf.CubeField.Name instead of pf.name)
  If bOLAP Then
  strFieldName = pf.CubeField.Name
  Else
  strFieldName = pf.Name
  End If
   
  With rs
  .AddNew
  .Fields("Field") = strFieldName
  Select Case pf.Orientation
  Case xlColumnField: strFieldtype = "xlColumnField"
  Case xlRowField: strFieldtype = "xlRowField"
  Case xlPageField: strFieldtype = "xlPageField"
  Case xlDataField: strFieldtype = "xlDataField"
  Case xlHidden: strFieldtype = "xlHidden"
  End Select
  .Fields("Orientation") = strFieldtype
  .Fields("Sheet") = wks.Name
  .Fields("Pivot") = wks.Name & "|" & pt.Name
  .Fields("Pivot|Field") = wks.Name & "|" & pt.Name & "|" & strFieldName
  .Fields("PivotCache") = pc.Index
  .Fields("SlicerCache") = 0
  Select Case pc.SourceType
  Case 1:
  .Fields("SourceType") = "xlDatabase"
  .Fields("Source") = pc.SourceData
  Case 2:
  .Fields("SourceType") = "xlExternal"
  .Fields("Source") = pc.CommandText
  Case 3:
  .Fields("SourceType") = "xlConsolidation"
  .Fields("Source") = ""
  Case 4:
  .Fields("SourceType") = "xlScenario"
  .Fields("Source") = ""
  Case -4148:
  .Fields("SourceType") = "xlPivotTable"
  .Fields("Source") = ""
  End Select
  End With
  End If
  Next pf
  Next pt
  End If
Next wks

For Each sc In ActiveWorkbook.SlicerCaches
  For Each pt In sc.PivotTables
  ' Loop through sheet/pivottable combos in the recordset to find a match
  ' Note that we don't loop directy through the Slicers Collection because it's possible
  ' for a SlicerCache to exist and control a Pivot without a dedicated Slicer existing
  With rs
  .MoveFirst
  Do Until rs.EOF
  If rs.Fields("Pivot|Field") = pt.Parent.Name & "|" & pt.Name & "|" & sc.SourceName Then .Fields("SlicerCache") = sc.Index
  .MoveNext
  Loop
  End With
  Next pt
Next sc


For Each sht In ActiveWorkbook.Worksheets
  For Each pt In sht.PivotTables
  If pt.Name = "PivotReport" Then
  Set rng = pt.TableRange2.Cells(1, 1)
  pt.TableRange2.Clear
  bPivotReportExists = True
  Exit For
  End If
  Next
Next
   
 If Not bPivotReportExists Then
  Set wks = Sheets.Add
  wks.Name = "PivotReport"
  Set rng = wks.Range("A1")
End If



Set pc = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set pc.Recordset = rs
Set pt = pc.CreatePivotTable(TableDestination:=rng)


With pt
  .Name = "PivotReport"
  .PivotFields("Sheet").Orientation = xlRowField
  .PivotFields("Pivot").Orientation = xlRowField
  .PivotFields("Field").Orientation = xlRowField
  .PivotFields("Orientation").Orientation = xlRowField
  .PivotFields("PivotCache").Orientation = xlRowField
  .PivotFields("SlicerCache").Orientation = xlRowField
  .PivotFields("SourceType").Orientation = xlRowField
  .PivotFields("Source").Orientation = xlRowField
   
   
  For Each pf In .PivotFields
  pf.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
  Next pf
   
  .RowAxisLayout xlTabularRow
  .ColumnGrand = False
  .RowGrand = False
  .RowAxisLayout xlTabularRow
  .RepeatAllLabels xlRepeatLabels
  .ShowTableStyleRowHeaders = False
  .ShowDrillIndicators = False
  .TableRange2.EntireColumn.AutoFit
End With


Application.ScreenUpdating = True
End Sub
 
Hi Jeff,

Thanks for the code, unfortunately I got a BUG early in the code at the following line:

Code: 
  .Fields.Append "Field", adVarChar, 500

Unsure of where to go from here.

Cheers

Natasha


jeffreyweir said:
How many different data sources are there?

THis code might help you easily work this out. Just put it it a standard module, and run it. It will insert a new sheet with a whole heap of info about your pivots.

Code: 
Sub PivotReport()
'  Desc:  Reports on
 
 
'  Programmer:  Jeff Weir
'  Contact:  weir.jeff@gmail.com
 
'  Name/Version:  Date:  Ini:  Modification:
'  PivotReport V1  20140808  JSW  Original Development
  
'  Inputs:
 
'  Outputs:
Dim rs As Object 'We're using late binding. If we were using early, we'd use Dim rs ADODB.Recordset
Dim sc As SlicerCache
Dim pt As PivotTable
Dim pc As PivotCache
Dim pf As PivotField
Dim wks As Worksheet
Dim sht As Worksheet
Dim rng As Range
Dim bPivotReportExists As Boolean
Dim bOLAP As Boolean
Dim strFieldtype As String
Dim strFieldName As String
 
 
Application.ScreenUpdating = False
 
Set rs = CreateObject("ADODB.Recordset") 'We're using late binding. If we were using early, we'd use Set rs = New ADODB.Recordset
With rs
  .Fields.Append "Field", adVarChar, 500
  .Fields.Append "Orientation", adVarChar, 50
  .Fields.Append "Sheet", adVarChar, 32 'Sheetnames can only be 32 characters
  .Fields.Append "Pivot", adVarChar, 500
  .Fields.Append "Pivot|Field", adVarChar, 1500
  .Fields.Append "PivotCache", adInteger
  .Fields.Append "SlicerCache", adInteger ', adFldIsNullable = True, adFldMayBeNull = True
  .Fields.Append "SourceType", adVarChar, 200
  .Fields.Append "Source", adVarChar, 5000
 
  .CursorLocation = adUseClient
  .CursorType = adOpenStatic
  .Open
End With
  
For Each wks In ActiveWorkbook.Worksheets
  If wks.Name <> "PivotReport" Then
  For Each pt In wks.PivotTables
  Set pc = pt.PivotCache
  'First, determine if the Pivot is based on an OLAP cube.
  ' If it is, then we'll want to record the pf.CubeField.Name instead of the pf.Name in the code below
  bOLAP = pt.PivotCache.OLAP
 
  For Each pf In pt.PivotFields
 
  If pf.Name <> "Values" Then
  'Record name of PivotField.
  ' (If pt based on OLAP, we want to record pf.CubeField.Name instead of pf.name)
  If bOLAP Then
  strFieldName = pf.CubeField.Name
  Else
  strFieldName = pf.Name
  End If
  
  With rs
  .AddNew
  .Fields("Field") = strFieldName
  Select Case pf.Orientation
  Case xlColumnField: strFieldtype = "xlColumnField"
  Case xlRowField: strFieldtype = "xlRowField"
  Case xlPageField: strFieldtype = "xlPageField"
  Case xlDataField: strFieldtype = "xlDataField"
  Case xlHidden: strFieldtype = "xlHidden"
  End Select
  .Fields("Orientation") = strFieldtype
  .Fields("Sheet") = wks.Name
  .Fields("Pivot") = wks.Name & "|" & pt.Name
  .Fields("Pivot|Field") = wks.Name & "|" & pt.Name & "|" & strFieldName
  .Fields("PivotCache") = pc.Index
  .Fields("SlicerCache") = 0
  Select Case pc.SourceType
  Case 1:
  .Fields("SourceType") = "xlDatabase"
  .Fields("Source") = pc.SourceData
  Case 2:
  .Fields("SourceType") = "xlExternal"
  .Fields("Source") = pc.CommandText
  Case 3:
  .Fields("SourceType") = "xlConsolidation"
  .Fields("Source") = ""
  Case 4:
  .Fields("SourceType") = "xlScenario"
  .Fields("Source") = ""
  Case -4148:
  .Fields("SourceType") = "xlPivotTable"
  .Fields("Source") = ""
  End Select
  End With
  End If
  Next pf
  Next pt
  End If
Next wks
 
For Each sc In ActiveWorkbook.SlicerCaches
  For Each pt In sc.PivotTables
  ' Loop through sheet/pivottable combos in the recordset to find a match
  ' Note that we don't loop directy through the Slicers Collection because it's possible
  ' for a SlicerCache to exist and control a Pivot without a dedicated Slicer existing
  With rs
  .MoveFirst
  Do Until rs.EOF
  If rs.Fields("Pivot|Field") = pt.Parent.Name & "|" & pt.Name & "|" & sc.SourceName Then .Fields("SlicerCache") = sc.Index
  .MoveNext
  Loop
  End With
  Next pt
Next sc
 
 
For Each sht In ActiveWorkbook.Worksheets
  For Each pt In sht.PivotTables
  If pt.Name = "PivotReport" Then
  Set rng = pt.TableRange2.Cells(1, 1)
  pt.TableRange2.Clear
  bPivotReportExists = True
  Exit For
  End If
  Next
Next
  
If Not bPivotReportExists Then
  Set wks = Sheets.Add
  wks.Name = "PivotReport"
  Set rng = wks.Range("A1")
End If
 
 
 
Set pc = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set pc.Recordset = rs
Set pt = pc.CreatePivotTable(TableDestination:=rng)
 
 
With pt
  .Name = "PivotReport"
  .PivotFields("Sheet").Orientation = xlRowField
  .PivotFields("Pivot").Orientation = xlRowField
  .PivotFields("Field").Orientation = xlRowField
  .PivotFields("Orientation").Orientation = xlRowField
  .PivotFields("PivotCache").Orientation = xlRowField
  .PivotFields("SlicerCache").Orientation = xlRowField
  .PivotFields("SourceType").Orientation = xlRowField
  .PivotFields("Source").Orientation = xlRowField
  
  
  For Each pf In .PivotFields
  pf.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
  Next pf
  
  .RowAxisLayout xlTabularRow
  .ColumnGrand = False
  .RowGrand = False
  .RowAxisLayout xlTabularRow
  .RepeatAllLabels xlRepeatLabels
  .ShowTableStyleRowHeaders = False
  .ShowDrillIndicators = False
  .TableRange2.EntireColumn.AutoFit
End With
 
 
Application.ScreenUpdating = True
End Sub
Click to expand...
 
Oh dear. Very strange. What version of Excel are you using? I'd love to work out why that's happening. Is there any chance you can email me the file? If so, flick it to weir.jeff@gmail.com

I've been meaning to recode that routine to use arrays, and not a recordset. Maybe this is a good time to do that.

Meanwhile, I'll code up something simpler today if I can and post it back here.
 
Hi Jeff,

I am using Excel 2013. Unable to email a copy of the report at this time. I will need to clear it of all sensitive data first. Which means I have to clear out the 6 or so supporting worksheets that run the pivot tables. After I do this I can send a copy of the report.

Cheers

Natasha

jeffreyweir said:
Oh dear. Very strange. What version of Excel are you using? I'd love to work out why that's happening. Is there any chance you can email me the file? If so, flick it to weir.jeff@gmail.com

I've been meaning to recode that routine to use arrays, and not a recordset. Maybe this is a good time to do that.

Meanwhile, I'll code up something simpler today if I can and post it back here.
Click to expand...
 
I'll recode it so that it (hopefully) works for you. This is the first step to working out what we need to connect to what.
 
You must log in or register to reply here.
Back
Top