I'm changing the data source of pivot table in excel using vba. I have this code below but it's returning a Type mismatch error at this line:
Set pvtcache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase,
SourceData:=DataRange)
Here's my script which I also got from various solutions in google and stackoverflow.
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim StartPoint As Range``
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
Dim pvtcache As PivotCache
Set Data_sht = wb.Sheets("FINAL_DATA")
Set Pivot_sht = wb.Worksheets("Summary")
PivotName = "PivotTable1"
'Dynamically Retrieve Range Address of Data
Set StartPoint = Data_sht.Range("A1")
Set DataRange = Data_sht.Range(StartPoint,
StartPoint.SpecialCells(xlLastCell))
NewRange = Data_sht.Name & "!" & _
DataRange.Address(RowAbsolute:=True, ColumnAbsolute:=True,
ReferenceStyle:=xlR1C1, External:=True)
'Change Pivot Table Data Source Range Address
Set pvtcache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase,
SourceData:=DataRange)
With Pivot_sht
.PivotTables(PivotName).ChangePivotCache pvtcache
End With
'Refresh Pivot Table
Pivot_sht.PivotTables(PivotName).RefreshTable
'Message
MsgBox PivotName & "'s data source range has been successfully updated!"
Only these lines will successfully create and change the Pivot Cache....
Set pvtcache = ThisWorkbook.PivotCaches.Create(xlDatabase, Data_sht.Name & "!" & Data_sht.Range("A1").CurrentRegion.Address)
Pivot_sht.PivotTables(1).ChangePivotCache pvtcache
Related
Currently have the following code:
Sub StartReport()
**Dim Month As String**
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
' Set variables equal to data sheet and pivot sheet
**Set Month = "B2"**
Set Data_sht = ThisWorkbook.Worksheets.**Month**
Set Pivot_sht = ThisWorkbook.Worksheets("Controller Report")
'Enter in Pivot table name
PivotName = "PivotTable1"
'Dynamically retrieve range address of data
Set StartPoint = Data_sht.Range("A1")
Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
NewRange = Data_sht.Name & "!" & _
DataRange.Address(ReferenceStyle:=x1R1C1)
'make sure every column in data set has a heading and is not blank (error prevention)
If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
MsgBox "One of your data columsn has a blank heading." & vbNewLine _
& "please fix and re-run!.", vbCritical, "Column heading Missing!"
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 refreashed
Pivot_sht.PivotTables("PivotTable1").RefreshTable
'Complete Message
MsgBox PivotName & " 's data source range has been successfully updated!"
End Sub
The parts which are bolded (have ** before and after them) are where i am having difficulty.
I want the data to be picked up from a drop down menu I have created, that has the names of all the tabs on them.
The drop down is located in cell "B2" on the first tab. When a month is selected from this dropdown, i want the datasheet with the same name to be selected as the data source for the pivot tables.
Please help
Detailed code and comments in the code below:
Option Explicit
Sub StartReport()
Dim PvtTbl As PivotTable
Dim myMonth As String
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
Dim LastCol As Long
Dim LastRow As Long
' Set variables equal to data sheet and pivot sheet
myMonth = ThisWorkbook.Sheets("Sheet1").Range("B2").Value2 ' <-- modify "Sheet1" to your sheet where you have the Drop-Down
' set the worksheet object according to the month selected
Set Data_sht = ThisWorkbook.Worksheets(myMonth)
Set Pivot_sht = ThisWorkbook.Worksheets("Controller Report")
'Enter in Pivot table name
PivotName = "PivotTable1"
' set the Pivot-Table object
Set PvtTbl = Pivot_sht.PivotTables(PivotName)
'Dynamically retrieve range address of data === Modified ===
With Data_sht
LastRow = FindLastRow(Data_sht)
LastCol = FindLastCol(Data_sht)
Set DataRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With
NewRange = DataRange.Address(False, False, xlA1, xlExternal)
'make sure every column in data set has a heading and is not blank (error prevention)
If WorksheetFunction.CountA(DataRange.Rows(1)) < DataRange.Columns.Count Then
MsgBox "One of your data columns has a blank heading." & vbNewLine _
& "please fix and re-run!.", vbCritical, "Column heading Missing!"
Exit Sub
End If
'Change pivot table data source range address
PvtTbl.ChangePivotCache ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=NewRange)
'Ensure pivot table is refreashed
PvtTbl.RefreshTable
'Complete Message
MsgBox PivotName & " 's data source range has been successfully updated!"
End Sub
Function FindLastCol(sht As Worksheet) As Long
' This Function finds the last col in a worksheet, and returns the column number
Dim LastCell As Range
With sht
Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False)
If Not LastCell Is Nothing Then
FindLastCol = LastCell.Column
Else
MsgBox "Error! worksheet is empty", vbCritical
End If
End With
End Function
Function FindLastRow(sht As Worksheet) As Long
' This Function finds the last row in a worksheet, and returns the row number
Dim LastCell As Range
With sht
Set LastCell = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False)
If Not LastCell Is Nothing Then
FindLastRow = LastCell.Row
Else
MsgBox "Error! worksheet is empty", vbCritical
End If
End With
End Function
Sub TestingMacros()
'
' TestingMacros Macro
'
Dim sht As Worksheet
Dim SrcData As String
Dim pvtCache As PivotCache
Sheets("Sheet1").Select
'Determine the data range you want to pivot
Set sht = ThisWorkbook.Worksheets("Sheet1")
SrcData = sht.Name & "!" & Range("A1:R23").Address(ReferenceStyle:=xlR1C1)
'Create New Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
'Change which Pivot Cache the Pivot Table is referring to
ActiveSheet.PivotTables("PivotTable1").ChangePivotCache (pvtCache)
End Sub
This last sentence (ActiveSheet.PivotTables("PivotTable1").ChangePivotCache (pvtCache)) has error 438. Cannot figure why.
Try the code below, explanations inside the code's comments:
Option Explicit
Sub TestingMacros()
' TestingMacros Macro '
Dim sht As Worksheet
Dim SrcRng As Range
Dim SrcData As String
Dim pvtCache As PivotCache
Dim pvtTbl As PivotCache
' Set the sheet obhect for the Pivot-Table data
Set sht = ThisWorkbook.Worksheets("Sheet1")
' set the data range for the Pivot-Table
Set SrcRng = sht.Range("A1:R23")
SrcData = SrcRng.Address(False, False, xlA1, xlExternal) ' get the Address string with sheet reference
' Create New Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
' set the Pivot-Table object
Set pvtTbl = sht.PivotTables("PivotTable1")
' Change which Pivot Cache the Pivot Table is referring to
pvtTbl.ChangePivotCache pvtCache
' refresh the Pivot-Table's data
pvtTbl.RefreshTable
End Sub
This worked for me:
Sub TestingMacros()
Dim sht As Worksheet
Dim SrcData As Range
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set SrcData = sht.Range("A1:R23")
sht.PivotTables("PivotTable1").ChangePivotCache _
sht.Parent.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=SrcData)
End Sub
Respected Expert, I am trying to execute below VBA code for Define my data and refresh the Pivot Table but I Am getting defined or object defined error-1004. Please guide me where I am doing mistake on below.
Sub Pivot()
Dim shPivot As Worksheet
Dim shData As Worksheet
Dim lr As Long
Dim lc As Long
Dim rng As Range
Set shPivot = ActiveWorkbook.Sheets("Data")
Set shData = ActiveWorkbook.Sheets("Pivot")
lr = shPivot.Range("A" & Rows.Count).End(xlUp).Row
Set rng = shPivot.Range(Cells(1, 1), Cells(lr, 32))
With shData.PivotTables("PivotTable1").PivotCache
.SourceData = rng.Address(True, True, xlR1C1, True)
.Refresh
End With
End Sub
Try the code below:
Option Explicit
Sub Pivot()
Dim shPivot As Worksheet
Dim shData As Worksheet
Dim PT As PivotTable
Dim PTCache As PivotCache
Dim lr As Long
Dim lc As Long
Dim Rng As Range
Set shPivot = ActiveWorkbook.Sheets("Data")
Set shData = ActiveWorkbook.Sheets("Pivot")
With shPivot
lr = .Range("A" & .Rows.Count).End(xlUp).Row
Set Rng = .Range(.Cells(1, 1), .Cells(lr, 32))
End With
' set the Pivot Cache with the updated Data Source
' Set PTCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Rng)
' === Option 2 : set the Pivot Cache with the updated Data Source ===
Set PTCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=shPivot.Name & "!" & Rng.Address(True, True, xlR1C1, False))
' Set the Pivot Table to existing "PivotTable1" in "Data" sheet
Set PT = shData.PivotTables("PivotTable1")
With PT
.ChangePivotCache PTCache
.RefreshTable
End With
End Sub
I've been debugging this code for hours in creating a pivot table, but unfortunately, I'm not able to figure out the problem. It keeps on displaying, Object doesn't support this property or method.
Sub CreatePivotTable()
Dim sht, srcSheet As Worksheet, ccsheet As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
Dim lrow As Long
Set srcSheet = ThisWorkbook.Sheets("Document Raw")
lrow = srcSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Set ccsheet = ThisWorkbook.Sheets("Character Count")
SrcData = srcSheet & "!" & Range("A1:V"& lrow).Address(ReferenceStyle:=xlR1C1)' this is the line that errors
StartPvt = ccsheet & "!" & ccsheet.Range("A79").Address(ReferenceStyle:=xlR1C1)
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1")
End Sub
Any help? Thanks
Try the modified code below (i prefer to setup up the Range, later the PivotCache and PivotTable and this method):
Sub CreatePivotTable()
Dim srcSheet As Worksheet
Dim ccSheet As Worksheet
Dim pvtCache As PivotCache
Dim pvtTbl As PivotTable
Dim StartPvt As Range
Dim SrcData As Variant
Dim lrow As Long
Set srcSheet = ThisWorkbook.Sheets("Document Raw")
lrow = srcSheet.Cells(srcSheet.Rows.Count, 1).End(xlUp).Row
Set ccSheet = ThisWorkbook.Sheets("Character Count")
' make sure you have valid data from Column A to Column V
Set SrcData = srcSheet.Range("A1:V" & lrow)
Set StartPvt = ccSheet.Range("A79")
'Create Pivot table from Pivot Cache
Set pvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, SrcData)
' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set pvtTbl = ccSheet.PivotTables("PivotTable1") ' check if "PivotTable1" Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If pvtTbl Is Nothing Then
Set pvtTbl = ccSheet.PivotTables.Add(PivotCache:=pvtCache, TableDestination:=StartPvt, TableName:="PivotTable1")
Else
pvtTbl.ChangePivotCache pvtCache
pvtTbl.RefreshTable
End If
End Sub
I am trying to add a pivot table to the same worksheet I am on (the sheet is called holders (corp)) but am having trouble with that.
Sub PivotTable()
Sheets("Sheet2").Select
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim pf As PivotField
Dim StartPvt As String
Dim SrcData As String
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).row
'Determine the data range you want to pivot
SrcData = ActiveSheet.Name & "!" & Range(Cells(1, "A"), Cells(LastRow,"E")).Address(ReferenceStyle:=xlR1C1)
'Create a new worksheet
Set sht = Sheets("HOLDERS (CORP)")
'Where do you want Pivot Table to start?
StartPvt = sht.Name & "!" & sht.Range("A1").Address(ReferenceStyle:=xlR1C1)
'Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
'Create Pivot table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="HolderssPivotTable")
End Sub
I get a debug issue related to the call procedure at the very last 3 lines of code but am not sure why. Help would be much appreciated!
Excel VBA cannot accept R1C1 cell addresses in Range objects.
Change
StartPvt = sht.Name & "!" & sht.Range("A1").Address(ReferenceStyle:=xlR1C1)
To
StartPvt = sht.Range("A1").Address
Then change
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="HolderssPivotTable")
End Sub
To
Set pvt = pvtCache.CreatePivotTable(TableDestination:=sht.Range(StartPvt), _
TableName:="HolderssPivotTable")
Update - Full refactored code to ensure pivot table ends up on Holders (CORP) sheet.
Sub PivotTable()
Dim sht2 As Worksheet
Set sht2 = Sheets("Sheet2")
With sh2
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Determine the data range you want to pivot
Dim SrcData As String
SrcData = .Name & "!" & .Range(.Cells(1, "A"), .Cells(LastRow, "E")).Address
End With
Dim sht As Worksheet
'Create a new worksheet
Set sht = Sheets("HOLDERS (CORP)")
'Where do you want Pivot Table to start?
Dim StartPvt As String
StartPvt = sht.Range("A1").Address
'Create Pivot Cache from Source Data
Dim pvtCache As PivotCache
Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData)
'Create Pivot table from Pivot Cache
Dim pvt As PivotTable
Set pvt = pvtCache.CreatePivotTable(TableDestination:=sht.Range(StartPvt), TableName:="HolderssPivotTable")
End Sub