How to update multiple Pivot Tables with multiple DataSources? - excel

Question

Hello beautiful people!
I am using Excel 2010 and I am trying to come up with a handy macro which would update all pivot tables in a workbook. I want it to be universal that means to be applicable to ANY workbook which contains pivot tables. By update I do not mean mere Pivot table Refresh as the data in our reports are getting rewritten and all that remains from the original source range is header. This means I need to Change the Data Source to new range dynamically.
Example: I have a Dashboard with 8 pivot tables on Summary sheet. Every Pivot table has its own DataSource on different sheet (pivot1 has data on Sheet1, pivot2 has data on Sheet2, etc.)
I started with a basic Macro which changes/updates the DataSource for a single Pivot table and which I use in various iterations in other macros - taken from here:
ActiveWorkbook.PivotTables(PivotTable1).ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData, _
Version:=xlPivotTableVersion15)
Now, my thought-process was like this:
Since the header is what is in the SourceData, I need to find a way to get that range and just expand it to last row with the usual
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
I tried to achieve this with .SourceData property but it appeared to be useless since property .SourceData is Variant type. So I did some digging around the excel forums some more and found a code to convert this into desired type:
Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))
I believe I implemented this correctly with some string trimming to get desired references but even though it looks great in theory (atleast in my eyes) I am getting runtime error (please see below) and now I am at loss. Therefore, I am turning to you guys to see if you could share some knowledge or offer an advice.
This is the current code I need help with (with explanations):
Sub pivot_updator()
Dim lastRow As Long
Dim pt As PivotTable
Dim ws As Worksheet
Dim dataArea As Range
Dim sSheetTrim As String
Dim sRangeTrim As String
For Each ws In ActiveWorkbook.Sheets
For Each pt In ws.PivotTables
'evaluate String to get Range after conversion from Variant - recovered from another forum
Set dataArea = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))
'some trimming to get desired references for lastRow (sheet in which the SourceData are located) and dataArea (starting cell and last column of SourceData)
sSheetTrim = Left(pt.SourceData, 6)
sRangeTrim = Left(dataArea.Address, 8)
lastRow = Sheets(sSheetTrim).Cells(Rows.Count, 1).End(xlUp).Row
'gluing the starting cell and lastcolumn (sRangeTrim) together with ending cell in last row (lastrow)
Set dataArea = Range(sRangeTrim & lastRow)
'test that I am getting correct Range for the pivot SourceData update
MsgBox dataArea.Address
'following gives me the Runtime error -2147024809(80070057)
pt.ChangePivotCache ActiveWorkbook. _
PivotCaches.Create _
(SourceType:=xlDatabase, _
SourceData:=dataArea, _
Version:=xlPivotTableVersion12)
'just to be sure the pivot table refreshes after the SourceData is updated
pt.RefreshTable
Next pt
Next ws
MsgBox "Pivot Update Done"
End Sub
Running this Sub prompts me with Runtime error -2147024809(80070057):
"The PivotTable field name is not valid. To create a pivot table report you must use data that is organized as a list with labeled columns, If you are changing the name of a PivotTable field, you must type a new name for the field."
What it should do is cycle through all Pivot Tables and expand their respective DataSource ranges to last row.
Since this is supposed to be all-time universal macro, you should be able to test it yourself on any workbook which contains pivot table.
I will be grateful for any suggestion and advice, also feel free to criticize my coding in general, I am fairly new to VBA. Thank you for spending your time looking into my issue and investing your beautifulness into it.

Answer 1

Beautiful people,
Fortunately, after taking a break and coming back to this issue with clear head, I was able to determine the problem. Even though the dynamic range cell references were set correctly, the scope of the range was not. There was no Sheet information in dataArea which is why the runtime error for invalid pivot table was present. It was probably a result of Application.Evaluate which omitted the sheet reference.
I had to further add a code which trimmed the string address to contain Sheet name on which pivot source data were located.
Please see amended code below:
Sub pivot_updator()
Dim lastRow As Long
Dim pt As PivotTable
Dim ws As Worksheet
Dim dataArea As Range
Dim sSheetTrim As String
Dim sRangeTrim As String
Dim SourceDataSheet As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
For Each ws In ActiveWorkbook.Sheets
For Each pt In ws.PivotTables
'evaluate String to get Range after conversion from Variant - recovered from another forum
SourceDataSheet = Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1)
Set dataArea = Application.Evaluate(Application.ConvertFormula(pt.SourceData, xlR1C1, xlA1))
'implemented fix - trim to get desired Sheet name on which pivot source data are located
sSheetTrim = Split(SourceDataSheet, "!")(0)
sSheetTrim = Split(SourceDataSheet, "'")(1)
sSheetTrim = Split(sSheetTrim, "]")(1)
'some trimming to get desired references for lastRow (sheet in which the SourceData are located) and dataArea (starting cell and last column of SourceData)
sRangeTrim = Left(dataArea.Address, 8)
lastRow = Sheets(sSheetTrim).Cells(Rows.Count, 2).End(xlUp).Row
'gluing the starting cell and lastcolumn (sRangeTrim) together with ending cell in last row (lastrow)
Set dataArea = Sheets(sSheetTrim).Range(sRangeTrim & lastRow)
'test that I am getting correct Range for the pivot SourceData update
'following gives me the Runtime error -2147024809(80070057) // MAYBE the DATA AREA DOES NOT DEFINE SHEET
pt.ChangePivotCache ActiveWorkbook. _
PivotCaches.Create _
(SourceType:=xlDatabase, _
SourceData:=dataArea, _
Version:=xlPivotTableVersion12)
'just to be sure the pivot table refreshes after the SourceData is updated
pt.RefreshTable
Next pt
Next ws
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
MsgBox "Pivot Update Done"
End Sub
The code is now working fine, I will see if there happen to be any mishaps I had not think of and possibly update the code.
I would like to thank anyone who commented on this question and proposed any solution and also to anyone who viewed it and read through it.
Thank you.