I need to change Pivot Source for multiple sheets. I am receiving error “Run-Time Error 424: Object Required” when executing Invoke VBA for code listed below. Note: The range for the source data will always be “A3”, but with a different Source Sheet Name.
SheetName = Excel Sheet that contains Pivot Table
SourceSheetName = Sheet for Pivot Table Source
Sub Change_Pivot_Source(SheetName,SourceSheetName, IntLastRow, IntLastColumn)
Sub Change_Pivot_Source()
Dim pt As PivotTable
For Each pt In ActiveWorkbook.Worksheets("Sheet2").PivotTables
pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:="Data2")
Next pt
End Sub
I have 6 sheets in an excel file. Sheets 1 & 2 use Sheet 5 as data source for pivot table, Sheets 3 & 4 use Sheet 6 as data source for pivot table. The range for Sheets 5 and 6 will be dynamic. Need to be able to pass parms to Invoke VBA.
I was able to resolve is by using to following VBA code.
Sub Change_Pivot_Source(SheetName,SheetSource,SourceRange,ErrMessage)
'PURPOSE: Automatically readjust a Pivot Table’s data source range
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
'==================================================
'Set Variables Equal to Data Sheet and Pivot Sheet
'==================================================
Set Data_sht = ThisWorkbook.Worksheets(SheetSource)
Set Pivot_sht = ThisWorkbook.Worksheets(SheetName)
'===========================
'Enter in Pivot Table Name
'===========================
PivotName = “PivotTable1”
'============================================
'Dynamically Setup Range Address of Data
'============================================
Set DataRange = Data_sht.Range(SourceRange)
'=====================================================================================
'Make sure every column in data set has a heading and is not blank (error prevention)
'=====================================================================================
If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
ErrMessage = “One of your data columns has a blank heading. Please fix and re-run!”
Exit Sub
End If
'=============================================
'Change Pivot Table Data Source Range Address
'=============================================
Pivot_sht.PivotTables(PivotName).ChangePivotCache _
ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=NewRange)
'================================
'Ensure Pivot Table is Refreshed
'================================
Pivot_sht.PivotTables(PivotName).RefreshTable