VBA - Code for pivot table won't generate table - vba

This is my first time trying to write a VBA code that generates a pivot table. The following is my code, when I run it I don't get any errors and the new worksheet is generated but not a pivot table in sight.
Thanks!
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("WorkCat PT").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "WorkCat PT"
Application.DisplayAlerts = True
Set PSheet = Worksheets("WorkCat PT")
DSheet = ActiveSheet.Data
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)
Set PTable = PCache.CreatePivotTable(TableDestination:=DSheet.Cells(2, 16), TableName:="WorkCatPivotTable")
With ActiveSheet.PTable.PivotFields("Work Category")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PTable.PivotFields("Total Cost")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PTable.PivotFields("Total Cost")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "$ #,##0"
.Name = "Work Category"
End With

Related

VBA Code to Create Pivot Table Was Working, Now it is Not

Any help would be appreciated. The Code below was working previously, now it is not. I have the exact same code for a different PIVOT table down below this one and it works perfectly. I'm scratching my head on this one.
'Pivot Tables
Sub TestPivot()
Sheets("Reported Sales").Select
'Declare Variables
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
'Declare Variables
Application.DisplayAlerts = False
Worksheets("Pivot Reported Sales").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Pivot Reported Sales"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Pivot Reported Sales")
Set DSheet = Worksheets("Reported Sales")
'Define Data Range
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)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), _
TableName:="Pivot Reported Sales")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(2, 2), TableName:="Pivot Reported Sales")
'Insert Row Fields
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("PROD_BASE_CD")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("Product Description")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("Compensation Category")
.Orientation = xlRowField
.Position = 3
End With
'Insert Data Field
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("PROD_SALES_AMT")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "$#,##0"
End With
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("INVC_DATE")
.Orientation = xlPageField
.Position = 1
End With
End Sub

Is there a way to put multiple pivot tables in the same sheet from the same pivot cache?

I'm trying to put two pivot tables into the same sheet but my second pivot table is not being created when I step into VBA. The code runs without any errors, but the second pivot table is never created. I'm looking to eventually add many pivot tables to the same sheet so any help with this would be appreciated.
I've tried setting two different caches, but I don't believe that will help solve this specific problem. I've also tried
Sub CreatePivottablewithVBA()
'Declare Variables
Dim Psheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim Ptable As PivotTable
Dim Ptable2 As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set Psheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Raw")
'Define Data Range
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)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=Psheet.Cells(2, 2), _
TableName:="SalesbyYearMonth")
'Insert Blank Pivot Table
Set Ptable = PCache.CreatePivotTable _
(TableDestination:=Psheet.Cells(1, 1), TableName:="SalesbyYearMonth")
'Insert Row Fields
With ActiveSheet.PivotTables("SalesbyYearMonth").PivotFields("ck_complete_dt")
.Orientation = xlRowField
.Position = 2
End With
'Insert Data Field
With ActiveSheet.PivotTables("SalesbyYearMonth").PivotFields("total_amount")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.Name = "# of Sales"
End With
With ActiveSheet.PivotTables("SalesbyYearMonth").PivotFields("total_amount")
.Orientation = xlDataField
.Position = 2
.NumberFormat = "$#,##0.00"
.Function = xlSum
.Name = "Total Amount"
End With
With ActiveSheet.PivotTables("SalesbyYearMonth").PivotFields("total_amount")
.Orientation = xlDataField
.Position = 3
.Calculation = xlPercentOfTotal
.NumberFormat = "0.00%"
.Name = "% of Total"
End With
'Format Pivot Table
ActiveSheet.PivotTables("SalesbyYearMonth").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("SalesbyYearMonth").TableStyle2 = "PivotStyleMedium9"
PivotTable.DataOnRows = False
'Create PivotTable2
Set Ptable2 = PCache.CreatePivotTable(TableDestination:=Psheet.Cells(22, 2), TableName:="SalesPerCategory")
With ActiveSheet.PivotTables("SalesPerCategory").PivotFields("highest_categ_level")
.Orientation = xlRowField
.Position = 1
.Name = "Category"
End With
With ActiveSheet.PivotTables("SalesPerCategory").PivotFields("highest_categ_level")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.Name = "Count of Categories"
End With
End Sub
I don't receive any error messages but I expect to see both pivot tables created in the sheet PivotTable

Getting #n/a when changing value field settings in Pivot table using vba

I have a use case where I filter the column values in a pivot and then change the value field settings of the pivot table. I am creating the pivot table and the sheet every time while deleting the previous one. My problem is that I am unable to get one column to reflect in the pivot but the values are correct in the grand total. My code is below:
Sub createPivotandFilter()
'Declare Variables
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 pf As PivotField
Dim PItems As PivotItem
'Insert a New Blank Worksheet
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("Data_TB Detail")
'Define Data Range
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)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(3, 1), _
TableName:="VariancePivot")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="VariancePivot")
With ActiveSheet.PivotTables("VariancePivot")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
'Insert Column Fields
With ActiveSheet.PivotTables("VariancePivot").PivotFields("Period")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("VariancePivot").PivotFields("LE")
.Orientation = xlColumnField
.Position = 2
End With
'Insert Row Fields
With ActiveSheet.PivotTables("VariancePivot").PivotFields("Mapped up 1st level")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("VariancePivot").PivotFields("Account")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("VariancePivot").PivotFields("Description")
.Orientation = xlRowField
.Position = 3
End With
'Insert Data Field
With ActiveSheet.PivotTables("VariancePivot").PivotFields("USD")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "Sum of USD"
.Calculation = xlDifferenceFrom
.BaseField = "Period"
.BaseItem = "Jun 30,2018"
End With
'adding the filter
Set PTable = ActiveSheet.PivotTables("VariancePivot")
Set pf = PTable.PivotFields("Period")
PTable.RefreshTable
temp = pf.PivotItems.Count
For i = 1 To temp
If pf.PivotItems(i).Value = "Jun 30,2018" Or pf.PivotItems(i).Value = "Sep 30,2018" Then
pf.PivotItems(i).Visible = True
Else
pf.PivotItems(i).Visible = False
End If
Next
End Sub
A screenshot of the result:
Any help is much appreciated.

My code to Create a Pivot works but the First row field does not work

I have been trying to create a pivot table in VBA and I partially succeeded even after creating the pivot cache and the pivot table the first rowFeild does not come up but the second rowFeild shows up even though I have numbered them as .position=1 and .position=2. Please can anyone help me as I am new to VBA coding and need help to fix this..
Where I have given the xlRowField to be "Natural Account" I have that column in my data and also the column "Natural Account Description" but still the code skips the "Natural Account" completely in row field and moves to the second not sure why. Also how to put it in a classic Pivot view my code is not working for that as well.
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
Worksheets("TempData").Activate
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("TempData")
'LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Select
'LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Range("A1").CurrentRegion
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(tabledestination:=PSheet.Cells(2, 2), TableName:="SalesPivotTable")
Set PTable = PCache.CreatePivotTable(tabledestination:=PSheet.Cells(2, 2), TableName:="SalesPivotTable")
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Natural Account")
.Orientation = xlRowField
.Position = 1
'.InGridDropZones = True
'.RowAxisLayout xlTabularRow
End With
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Natural Account Description")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("ME")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Net Closing Balance")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
End With
ActiveSheet.PivotTables("SalesPivotTable").RowAxisLayout xlTabularRow
'With ActiveSheet.PivotTables("SalesPivotTable")
'.InGridDropZones = True
'.RowAxisLayout xlTabularRow
'End With

VBA code for creating Pivot Table

I have created a macro that builds a pivot table. It runs great but I want to dismiss the circled content in the screenshot provided .. I dont want to have the total inside the pivot. Only at the bottom the Grand Total! I am providing my code and a screenshot. Moreover, is it possible to substitute the "Row Labels" text in column B with "FDD"?
Sub aa()
'Declare Variables
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
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Customs_report").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Customs_report"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Customs_report")
Set DSheet = Worksheets("Zeikan")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(6, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(6, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Commodity Code")
.Orientation = xlRowField
.Position = 1
.Name = "Commodity Code"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Location")
.Orientation = xlRowField
.Position = 2
End With
'Insert Column Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Quantity (cases/sw)")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.Name = "Sum of Quantity (cases/sw)"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Quantity (items)")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
.Name = "Sum of Quantity (items)"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Net value")
.Orientation = xlDataField
.Position = 3
.Function = xlSum
.Name = "Sum of Net value"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Gross weight (Kg)")
.Orientation = xlDataField
.Position = 4
.Function = xlSum
.Name = "Sum of Gross weight (Kg)"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Net weight (Kg)")
.Orientation = xlDataField
.Position = 5
.Function = xlSum
.Name = "Sum of Net weight (Kg)"
End With
End Sub
You can toggle the subtotals:
With PTable.PivotFields("Commodity Code")
.Orientation = xlRowField
.Position = 1
.Name = "Commodity Code"
.Subtotals(1) = True
.Subtotals(1) = False
End With
to change the header, change the table layout to tabular
PTable.LayoutRowDefault = xlTabularRow
before you add the fields. BTW, you should be using PTable rather than ActiveSheet.PivotTables("PivotTable") in the rest of your code.