Hi, Here is the full program that conficts with the loading of the data into the dashboard pivot tables.
I need to update/ refresh all before this program becomes active.
Option Explicit
Sub SyncPivotFields(target)
'downloaded from www.contextures.com
'revised code by Jeff Weir, August 2012
' Date Ini Modification
' 20/09/12 JSW Added ability to exclude PivotFields, and
' also extended code to sync slave RowFields
'specify any PivotFields that you DON'T want to check
'in section marked with '#######
'specify any WorkSheets that you DON'T want to check
'in section marked with '*******
'specify any PivotTables that you DON'T want to change (but that are in WorkSheets that you DO want to check)
'in section marked with '=======
Dim TimeTaken As Date
TimeTaken = Now()
Dim pf_Master As PivotField
Dim pt_Master As PivotTable
Dim pi_Master As PivotItem
Dim bPageField As Boolean
Dim bFiltered As Boolean
Dim bUseDictionary As Boolean
Dim bMI As Boolean
Dim bFoundAll As Boolean
Dim dicPivotItems As Object '(We are using late binding. 'If we were using early binding we would have used this: Dim dicPI_MasterItems As Scripting.Dictionary
Dim wks As Worksheet
Dim pt_slave As PivotTable
Dim pf_Slave As PivotField
Dim pi_Slave As PivotItem
Dim varMasterItems As Variant
Dim lngFound As Long
Dim lngVisibleItem As Long
Dim lngVisibleItems As Long
Application.EnableEvents = False
Application.ScreenUpdating = False
Set pt_Master = target
On Error GoTo errhandler
'Cycle through all pagefields in the master pivot table
'
For Each pf_Master In pt_Master.VisibleFields
If pf_Master.Orientation = xlPageField Then
Select Case pf_Master.Name
'########################################################################################
'Here's where we list any PivotFields in the master pivot that we want to ignore
' You simply list the pivotfield name in quotes, with the word Case in front.
' e.g. Case "SomePivotfieldWeDontWantToChange"
' For instance, for this particular example, if we had a field called "ExampleField"
' then we could have the code skip it by adding this:
' Case "Resolved Date"
' Case "Item"
'do nothing
' The 'do nothing comment is completely optional and in fact does nothing other than
' make it clear to anyone reading the code that the macro does not proces this field
'########################################################################################
Case Else
bFiltered = Not pf_Master.AllItemsVisible
bMI = pf_Master.EnableMultiplePageItems
If bMI Then 'there's possibly more than one visible field, so we need to find out which ones
If bFiltered Then 'if NO fields are filtered, then no need to find out which ones. But otherwise we do.
ReDim varMasterItems(0) 'Reset the array
lngVisibleItems = 0 'reset the counter
For Each pi_Master In pf_Master.PivotItems
If pi_Master.Visible Then 'add any visible pivotitems to our master list
ReDim Preserve varMasterItems(lngVisibleItems)
varMasterItems(lngVisibleItems) = pi_Master.Name
lngVisibleItems = lngVisibleItems + 1
If Not bMI Then Exit For 'there is only one item, and we just found it. So we can continue to next part of routine
End If 'If pi_Master.Visible Then
Next pi_Master
End If 'If bFiltered Then
Else
ReDim varMasterItems(0) 'Reset the array
varMasterItems(0) = pf_Master.CurrentPage.Name
lngVisibleItems = 1
End If 'If bMI Then
For Each wks In ThisWorkbook.Worksheets
Select Case wks.Name
'**********************************************************************************************************
'Here's where we list any WORKSHEETS that we DO NOT want to check
' You simply list the worksheet name in quotes, with the word Case in front.
' e.g. Case "Some Unimportant Sheet"
Case "Dashboard (Detailed)"
Case "Dashboard (Group)"
Case "PSO Arrival Table"
Case "PSO Passed Table"
' You can add an optional 'do nothing comment on the following line if you like.
' This makes it clear to anyone reading the code that the macro does not proces this sheet
'***********************************************************************************************************
Case Else
For Each pt_slave In wks.PivotTables
Select Case wks.Name & "_" & pt_slave.Name
Case ActiveSheet.Name & "_" & pt_Master.Name
'do nothing: This is the master pivot that we just changed.
'===============================================================================================================
'Here's where we list any PIVOTTABLES that we DO NOT want to check.
' You simply list the worksheet name then an underscore, then the pivottable name, all in quotes, with the word Case in front.
' e.g. for a PivotTable called "Do not show" in a worksheet called "My Pivots" you would do this (WITHOUT the apostrophe in front):
' Case "My Pivots_Do not show"
'Case "Dashboard (Open Daily)"
Case "Dashboard (Open Multi)_PivotTable5"
Case "Dashboard (Open Multi)_PivotTable6"
'Case "Dashboard (Overview)"
'Case "Dashboard (Detailed)"
Case "Dashboard (Individual)_PivotTable1"
Case "Dashboard (Individual)_PivotTable2"
' You can add an optional 'do nothing comment on the following line if you like.
' This makes it clear to anyone reading the code that the macro does not proces this PivotTable
'do nothing
'===================================================================================================================
Case Else
pt_slave.ManualUpdate = True
For Each pf_Slave In pt_slave.VisibleFields
bPageField = False
If pf_Slave.Orientation = xlPageField Then bPageField = True
If pf_Slave.Name = pf_Master.Name Then
pf_Slave.ClearAllFilters
If Not bFiltered Then
' Nothing in pf_Master is filtered.
' Neither is anything in pf_Slave, because we've just cleared filters above.
' So if the slave field is a page field, then just
' change the .EnableMultiplePageItems checkbox to match the Master
If pf_Slave.Orientation = xlPageField Then pf_Slave.EnableMultiplePageItems = bMI
Else:
Select Case bMI
Case False
' "Enable Multiple Items" setting is set to False.
' So pf_Master has either ONE item selected, or All items selected.
' Which is great, because IF pf_Slave is ALSO a page field, we can
' set it to the same setting with just 2 lines of code
If pf_Slave.Orientation = xlPageField Then
pf_Slave.EnableMultiplePageItems = False
pf_Slave.CurrentPage = pf_Master.CurrentPage.Value
Else:
' Damn, pf_Slave is NOT a pagefield, so we can't set it to the same settings.
bUseDictionary = True
End If ' If pf_Slave.Orientation = xlPageField Then
Case True ' More than one (but less than all) items are selected, so we'll have to use the Dictionary
bUseDictionary = True
End Select ' Select Case bMI
If bUseDictionary = True Then
' Either pf_Master has multiple items,
' OR pf_Slave is a rowfield. So we have to change filter via below approach
If pf_Slave.Orientation = xlPageField Then pf_Slave.EnableMultiplePageItems = True
' Dump the contents of our master list into a dictionary
' Note that you CAN'T do this by going Set Dictionary1 = Dictionary2,
' because any changes you make in one would be reflected in the other.
Set dicPivotItems = Nothing
Set dicPivotItems = CreateObject("Scripting.Dictionary")
For lngVisibleItem = 0 To UBound(varMasterItems)
dicPivotItems.Add varMasterItems(lngVisibleItem), varMasterItems(lngVisibleItem)
Next lngVisibleItem
' Dump ALL PIs of matching PFs from slave PT to that dictionary.
' If there is a match, VBA will throw an error and we will know to NOT hide that item.
' IF there is no match (and no error), we SHOULD hide that item
On Error Resume Next
lngFound = 0
For Each pi_Slave In pf_Slave.PivotItems
If lngFound = lngVisibleItems Then
' We've found all the visible items, so just hide the remainder without checking
pi_Slave.Visible = False
Else:
' We haven't yet found all the visible items, so keep checking.
dicPivotItems.Add pi_Slave.Name, pi_Slave.Name
If Err.Number = 0 Then
' It's not one of the master visible items, so hide it
pi_Slave.Visible = False
Else:
Err.Clear
lngFound = lngFound + 1
End If ' If Err.Number = 0
End If ' If lngFound = lngVisibleItems
Next pi_Slave
On Error GoTo 0
End If ' If bUseDictionary = True Then
bUseDictionary = False
End If ' If Not bFiltered Then
End If ' If pf_Slave.Name = pf_Master.Name
Next pf_Slave
End Select ' Select Case wks.Name
pt_slave.ManualUpdate = False
Next pt_slave
End Select
Next wks
End Select ' Select Case pf_Master.Name
End If ' If pf_Master.Orientation = xlPageField Then
Next pf_Master
errhandler:
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, "Whoops, something went wrong..."
Else
TimeTaken = Now() - TimeTaken
Debug.Print Now() & " SyncPivotFields took " & Format(TimeTaken, "HH:MM:SS") & " seconds."
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'Private Sub Worksheet_PivotTableUpdate(ByVal target As PivotTable)
'SyncPivotFields target
'End Sub
