Hi all,
I have a bunch of reports that require dozens of pivot tables to be updated. The pivot tables within a single report all access the same data source, but across the portfolio of reports there are multiple different data sources (which is why I have the prompt to choose a source data file).
Some of the reports require the source data to be cached within the workbook so that people can manipulate the data. Other reports do not require the source data to be cached.
My problem is that when I need the source data cached, it looks like my macro is creating a cache for EACH pivot table even though I'm trying to only get it to create the cache once and have each subsequent pivot table reference that cache. The result is my file size is gigantic.
Could someone please take a look at my code and tell me what I'm doing wrong and how to fix it? I've highlighted the most relevant sections in orange.
Key goals:
Maintain ability to choose different file sources
Maintain ability to choose whether to turn on/off the Save Data with File
Create a single cache for each workbook and have all pivot tables source from that cache
Here is the macro:
Option Explicit
Sub ChangeExternalPivotSource()
'Works only for *EXTERNAL* sources. This macro dynamically changes every pivot table's data source range in the workbook
'and displays the new source data/range. It *must* be run from the workbook that
'contains the pivot tables to be refreshed.
Dim fileToBeUpdatedPath As String
Dim fileToBeUpdatedName As String
Dim wkbkToBeUpdated As Workbook
Dim fullSourcePathAndFileName As String
Dim sourceFileName As String
Dim sourceWkbk As Workbook
Dim sourceSheet As Worksheet
Dim sourcePath As String
Dim lastRow As Long
Dim lastCol As Long
Dim sourceRng As Range
Dim sourceAddressEnd As String
Dim sourceAddressFull As String
Dim sht As Worksheet
Dim pvt As PivotTable
Dim StartPoint As Range
Dim pivotCount As Integer
Dim lastColAlpha As String
Dim continueYesNo As Integer
Dim pvtCache As PivotCache
Dim saveSourceDataToggle As Boolean
'Macro must be run from the workbook that is going to have its pivot tables refreshed!
'Application.ScreenUpdating = False
fileToBeUpdatedPath = ActiveWorkbook.FullName
fileToBeUpdatedName = Dir(fileToBeUpdatedPath)
Set wkbkToBeUpdated = Workbooks(fileToBeUpdatedName)
'Enter Worksheet Name that holds your Pivot data source
fullSourcePathAndFileName = Application.GetOpenFilename
Workbooks.Open fullSourcePathAndFileName, UpdateLinks:=False
sourceFileName = Dir(fullSourcePathAndFileName)
Set sourceWkbk = Workbooks(sourceFileName)
'This macro will not work unless the source data is stored in the first sheet of whichever workbook you point to
Set sourceSheet = sourceWkbk.Worksheets(1)
sourcePath = sourceWkbk.Path
'Find the last non-blank cell in column 1 - critical that no random calcs or data be on the bottom of this column
lastRow = sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Find the last non-blank cell in row 1 - critical that no random calcs or data exist beyond the data set on this row
lastCol = sourceSheet.Cells(1, Columns.Count).End(xlToLeft).Column
'Create SourceData address - data must start in cell A1
Set sourceRng = sourceSheet.Range(sourceSheet.Cells(1, 1), sourceSheet.Cells(lastRow, lastCol))
sourceAddressEnd = sourceSheet.Name & "!" & sourceRng.Address(ReferenceStyle:=xlR1C1)
sourceAddressFull = sourcePath & "\[" & sourceFileName & "]" & sourceAddressEnd
'Now return the focus to the report to be updated instead of the data source (which became the active workbook when it was opened)
pivotCount = 0
wkbkToBeUpdated.Activate
'Create one PivotCache object - the sourceData element of this object will be used to update all pivots
Set pvtCache = wkbkToBeUpdated.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sourceAddressFull)
'Prompt user for whether or not they want to embed source data within file? Sometimes this is necessary,
'but default position is to not save data with file
saveSourceDataToggle = False
If MsgBox("Would you like to save the source data within this file?", vbYesNo) = vbYes _
Then saveSourceDataToggle = True
'Loop through and update pivot tables with new data source range
For Each sht In wkbkToBeUpdated.Worksheets
sht.Activate
For Each pvt In sht.PivotTables
pvt.TableRange1.Activate
If MsgBox("About to update " & pvt.Name & ". Do you want to continue?", vbYesNo) = vbNo Then End
'Change each Pivot Table's data source range address and make a count of how many pivot tables there are as a sense check
pivotCount = pivotCount + 1
pvt.SourceData = pvtCache.SourceData
'If pvt.SaveData <> saveSourceDataToggle Then pvt.SaveData = saveSourceDataToggle
'Ensure Pivot Table is refreshed - turned this off for now because it seems it is autorefreshing
'pvt.RefreshTable
MsgBox (pvt.Name & " has been refreshed!")
Next pvt
Next sht
End Sub
Thanks for the help.
Bookmarks