Insert pivot table from VBA - vba

Question

I have been trying for hours now to create a pivot table from VBA. I've tried various codes but i keep getting errors. The following code does not create a pivot table it only creates a new sheet. I have a sheet called "Base" where all my data is. It has 18288 rows and 13 columns with data. Can anyone help me with why the code isn't working for me
Sub pivottable()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PRange As range
Dim LastRow As Long
Dim LastCol As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Base")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
Sheets("PivotTable").Select
With ActiveSheet.PivotTables("PivotTable").PivotFields("FACULTY_ID")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("PROGRAM_TYPE_NAME")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables( _
"PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum
End Sub

Answer 1

This might work for you:
Sub pivottable()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim new_sheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Application.DisplayAlerts = True
On Error GoTo 0
new_sheet_name = "PivotTable"
pivot_table_name = "pivot_name_here"
Set new_sheet = Sheets.Add(Before:=ActiveSheet)
With new_sheet
.Name = new_sheet_name
End With
Set PSheet = new_sheet
Set DSheet = Worksheets("Base")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
Set PCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=PRange.Address(, , xlR1C1))
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1).Address(, , xlR1C1), TableName:=pivot_table_name)
With PTable.PivotFields("FACULTY_ID")
.Orientation = xlRowField
.Position = 1
End With
With PTable.PivotFields("PROGRAM_TYPE_NAME")
.Orientation = xlRowField
.Position = 2
End With
With PTable
.AddDataField ActiveSheet.PivotTables( _
"PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum
End With
End Sub

Answer 2

Looks like this link is cold, but in case someone else wants to do this, here's code I adapted from other answers (StackOverflow and elsewhere) to create several Pivot Tables. This code receives a Global Variable from above that is an array with 7 salesman's names. The code:
Finds the range of the data on each "salesman's" sheet.
Creates a Pivot Table Cache with the salesman's name (this was the key to getting it to work).
Creates a Pivot table with the salesman's name.
Labels and sorts the Pivot Table.
Moves on to the next Sheet.
Sub Pivot_Maker() 'adapted from the internet. I added the arrays tho - AAI
'as of 11/26/2019
Dim FinalRow As Long
Dim DataSheet As String
Dim PvtCache As PivotCache
Dim PvtTbl(7) As PivotTable
Dim DataRng As Range
Dim TableDest As Range
i = 0
Do While i < NumSalesPeeps
Sheets(Salesman(i)).Select
Range("A1").Select
If IsEmpty(Range("A30")) Then GoTo No_Data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
DataSheet = ActiveSheet.Name
PvtTblName = ActiveSheet.Name & "pvt"
' set data range for Pivot Table
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 10)) ' conversion of R1C1:R & FinalRow & C8
' set range for Pivot table placement
Set TableDest = Sheets(DataSheet).Cells(1, 12) ' conversion of R1C9
Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng)
' this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables(PvtTblName) ' check if PvtTblName Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If PvtTbl(i) Is Nothing Then ' PvtTblName doesn't exist >> create it
' create a new Pivot Table in PvtTblName sheet
Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:=PvtTblName)
With PvtTbl(i).PivotFields("Account")
.Orientation = xlColumnField
.Position = 1
End With
With PvtTbl(i).PivotFields("Name")
.Orientation = xlRowField
.Position = 1
End With
PvtTbl(i).AddDataField ActiveSheet.PivotTables( _
PvtTblName).PivotFields("Amount"), "Sum of Amount", xlSum
Else
' just refresh the Pivot cache with the updated Range
PvtTbl(i).ChangePivotCache PvtCache
PvtTbl(i).RefreshTable
End If
With ActiveSheet.PivotTables(PvtTblName).PivotFields("Sum of Amount")
.NumberFormat = "$#,##0"
End With
No_Data:
i = i + 1
Loop
End Sub