Update Pivot table using a dynamic range for source data

[Carl Thompson]

Hi,

I have multiple pivots in a spreadsheet contained within numerous worksheets. Each quarter I update my data by adding data within an additional column to the right of my existing data. The pivot tables only show the last 8 quarters of the existing data. At present I manually change the datafields of all the pivots so that only the last 8 quatrters are visible and then I refresh the pivot to obtain the data. I would like some code to automate this process.

The following code is my attempt:

Please Login or Register  to view this content.

The problem I am having relates to the line of code below:

PT.PivotTableWizard SourceType:=xlDatabase, SourceData:=rng

I am receiving the following error message:

'Run time error 1004'
Application-defined or object-defined error

The object "rng" which is providing the source data should update everytime some additional data is added to my existing array and therefore the pivot table and the datafields which are visible should also update.

Can anyone help?

[Carl Thompson]

Hi,

After some testing it would seem that part of the problem may be because I am not specifying the exact pivot table I am trying to update. I would have thought that the For Each statement would have defined this but that doesn't appear to be the case. In some instances the code attempts to recreate a new pivot table in a random cell/sheet position. I believe that this may have something to do with the following code not specifying the table destination of the Pivot table. However, as I am trying to loop through multiple pivot tables I cannot define this as a specific variable.

Code below:

ws.PivotTableWizard SourceType:=xlDatabase, SourceData:=rng

Does anyone have any ideas?

Thanks Carl

[Kyle123]

Hi Carl,

I haven't tested this, but I think it should work. Could you just use a dynamic named range to select the last 8 columns as the source of your pivot tables and then just refresh them? I think this should then only display the data available - the last 8 Quarters?

You would then only need to refresh the pivot tables rather than change the fields

Or do you need all the data in the worksheet in your pivot table?

[Carl Thompson]

Hi Kyle,

Are you referring to using an Offset function within the define name range to calculate the last 8 columns worth of data and use that as my data source?

I have considered this but in order to do some further analysis it would be beneficial if all of my previous quarters were still captured within the Pivot Table source data. I have graphs and further tables referencing the pivot tables.

In addition, the quarterly data that is stored for each quarter is not the only data that is captured within the worksheet meaning the Offset function would have to be significantly amended to capture only the specified data (held at the furthest left of the worksheet).

Unfortunately, I have inherited the spreadsheet and it's layout and recreating from scratch is likely to take even more time.

I believe that my code should do similar to the Offset function and resolve the issue of additional data captured further to the right of my Pivot Table data. Using Ron de Bruin's(5 May 2008) Last Function to determine the last column and row of a contiguous array of data should capture all of my required data for my Pivot table.

I have amended my code again as all my pivots were referencing the range on the first worksheet!! I have now captured my "Set rng = Range("A4").currentregion" within my for each worksheet and for each pivot loops which ensures that the range specified for each pivot is within it's own worksheet.

However, the issue I am having is the code recognising when there has been an additional column added. I need to refresh the pivot table's recognition of the source data!!??

My code below:

Sub Refresh_All_Pivots()

On Error GoTo err_handler

Application.ScreenUpdating = False

Dim field1 As String
Dim field2 As String
Dim field3 As String
Dim field4 As String
Dim field5 As String
Dim field6 As String
Dim field7 As String
Dim field8 As String

Dim ws As Worksheet
Dim Pt As PivotTable
Dim pf As PivotField

Dim rng As Range
Dim lastcol As Long
Dim LastRow As Long

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
For Each Pt In ws.PivotTables

Set rng = Range("A4").currentregion

Range("A4").currentregion.Select

LastRow = Last(1, rng)
lastcol = Last(2, rng)

field1 = rng.Cells(1, (lastcol) - 7).Text
field2 = rng.Cells(1, (lastcol) - 6).Text
field3 = rng.Cells(1, (lastcol) - 5).Text
field4 = rng.Cells(1, (lastcol) - 4).Text
field5 = rng.Cells(1, (lastcol) - 3).Text
field6 = rng.Cells(1, (lastcol) - 2).Text
field7 = rng.Cells(1, (lastcol) - 1).Text
field8 = rng.Cells(1, (lastcol)).Text

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=rng

For Each pf In Pt.DataFields
pf.Orientation = xlHidden
Next pf

With Pt.PivotFields(field1)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field1
.Function = xlSum
End With


With Pt.PivotFields(field2)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field2
.Function = xlSum
End With

With Pt.PivotFields(field3)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field3
.Function = xlSum
End With

With Pt.PivotFields(field4)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field4
.Function = xlSum
End With

With Pt.PivotFields(field5)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field5
.Function = xlSum
End With

With Pt.PivotFields(field6)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field6
.Function = xlSum
End With

With Pt.PivotFields(field7)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field7
.Function = xlSum
End With

With Pt.PivotFields(field8)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field8
.Function = xlSum
End With

Pt.RefreshTable
Errorhandling:

Next Pt
Next ws

ActiveWorkbook.ShowPivotTableFieldList = False
Application.ScreenUpdating = True

Sheet1.Activate

Exit Sub

err_handler:
MsgBox "One or more of the Pivot tables have experienced an error." & vbCrLf & vbCrLf & _
'"Please look through the workbook to determine where the error has occurred.", _
'vbOKOnly, "Error with Refreshing Pivots"

Resume Errorhandling

End Sub


As stated above the problem I am having is that I need to refresh the existing pivot table's recognition of the source data?? I attempted to do this by using the following line of code:

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=rng

However, the above code will create a new pivot table within a newly created worksheet. This new pivot will recognise the "new" source data with the additional columns. However, the source data for the existing pivots is not refreshed. I believe it is probably something to do with not defining the tabledestination of the pivots within the above code. However, as I am trying to update multiple pivots within worksheets across multiple worksheets I cannot specify an exact range/cell position within the above line of code.

Is it that this line of code is not acting within the:

For each ws
For each pt

loop?

I am fairly new to VBA but am beginning to pick up some of the basics but I have no idea how I can make the foloowing code act upon each existing pivot table in turn whilst recognising it's already defined tabledestination reference:

ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=rng

I hope I've explained myself well enough and apologies for any incorrect use of terminology.

If anyone could help it would be fantastic and I could put this proble to rest.

Thanks

Carl

[Carl Thompson]

Hi,

Me again!!

I think I've cracked it!!

The below code should be able to be amended for user needs in order to update the datafields and refresh a dynamic pivot table.

Code:

Sub Refresh_All_Pivots()

'On Error GoTo err_handler

Application.ScreenUpdating = False

Dim field1 As String
Dim field2 As String
Dim field3 As String
Dim field4 As String
Dim field5 As String
Dim field6 As String
Dim field7 As String
Dim field8 As String

Dim ws As Worksheet
Dim Pt As PivotTable
Dim pf As PivotField

Dim rng As Range
Dim lastcol As Long
Dim LastRow As Long

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
For Each Pt In ws.PivotTables

Set rng = Range("A4").currentregion

LastRow = Last(1, rng)
lastcol = Last(2, rng)

field1 = rng.Cells(1, (lastcol) - 7).Text
field2 = rng.Cells(1, (lastcol) - 6).Text
field3 = rng.Cells(1, (lastcol) - 5).Text
field4 = rng.Cells(1, (lastcol) - 4).Text
field5 = rng.Cells(1, (lastcol) - 3).Text
field6 = rng.Cells(1, (lastcol) - 2).Text
field7 = rng.Cells(1, (lastcol) - 1).Text
field8 = rng.Cells(1, (lastcol)).Text

Pt.SourceData = Range("A4").currentregion.Address(True, True, xlR1C1, True)

Pt.DataPivotField.Orientation = xlHidden

With Pt.PivotFields(field1)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field1
.Function = xlSum
End With

With Pt.PivotFields(field2)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field2
.Function = xlSum
End With

With Pt.PivotFields(field3)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field3
.Function = xlSum
End With

With Pt.PivotFields(field4)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field4
.Function = xlSum
End With

With Pt.PivotFields(field5)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field5
.Function = xlSum
End With

With Pt.PivotFields(field6)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field6
.Function = xlSum
End With

With Pt.PivotFields(field7)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field7
.Function = xlSum
End With


With Pt.PivotFields(field8)
.Orientation = xlDataField
.Caption = "Sum of" & " " & field8
.Function = xlSum
End With

Pt.RefreshTable
Errorhandling:

Next Pt
Next ws

ActiveWorkbook.ShowPivotTableFieldList = False
Application.ScreenUpdating = True

Sheet1.Activate

Exit Sub

err_handler:
MsgBox "One or more of the Pivot tables have experienced an error." & vbCrLf & vbCrLf & _
"Please look through the workbook to determine where the error has occurred.", _
vbOKOnly, "Error with Refreshing Pivots"

Resume Errorhandling

End Sub


Please let me know if anyone finds a fault with using this code. Otherwise, I hope this is useful and saves you plenty of time.

Thanks

Carl

[arthurbr]

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here