VBA code for creating Pivot Table - vba

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.

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.

VBA - Code for pivot table won't generate table

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

Error while creating Pivot Table automatically

I have created a macro to create a table with some values via Index matches and general calculations. This table is located on the range("AA1:BA"&LastRow) --> I am writing LastRow because the lastrow changes daily. I want to create a pivot table which will be located in the cell(9,1) and will have as a source the initial table that I created.. I built the code that you see below, but it gives me an error saying that the PivotTable field name is not valid on the line :
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="PivotTable")
The entire code related to the Pivot Table is below.
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
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Set PSheet = Worksheets("Budget_Report")
Set DSheet = Worksheets("Budget_Report")
LastRow = DSheet.Cells(Rows.Count, 27).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 27).Resize(LastRow, LastCol)
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(9, 1), TableName:="PivotTable")
With ActiveSheet.PivotTables("PivotTable").PivotFields("T-Lane")
.Orientation = xlRowField
.Position = 1
.Subtotals(1) = True
.Subtotals(1) = False
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Monthly Cost FCST")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.Name = "Monthly Cost Forecast"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Monthly Vol FCST")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
.Name = "Monthly Vol Forecast"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Monthly $/SU FCST")
.Orientation = xlDataField
.Position = 3
.Function = xlSum
.Name = "Monthly $/SU Forecast"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Monthly Cost Actuals")
.Orientation = xlDataField
.Position = 4
.Function = xlSum
.Name = "Monthly Cost Actual"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Monthly Vol Actuals")
.Orientation = xlDataField
.Position = 5
.Function = xlSum
.Name = "Monthly Vol Actual"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Monthly $/SU Actuals")
.Orientation = xlDataField
.Position = 6
.Function = xlSum
.Name = "Monthly $/SU Actual"
End With
The recorded macro that builds the Pivot Table is provided below (it has specific range not lastrow and lastcolumn of course)
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Budget_Report!R1C27:R279C53", Version:=6).CreatePivotTable TableDestination:="Budget_Report!R9C1", TableName:="PivotTable1", DefaultVersion:=6
Sheets("Budget_Report").Cells(9, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("T-Lane")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("Monthly Cost FCST"), "Monthly Cost Forecast", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("Monthly Vol FCST"), "Monthly Vol Forecast", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("Monthly $/SU FCST"), "Monthly $/SU Forecast", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("Monthly Cost Actuals"), "Monthly Cost Actual", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("Monthly Vol Actuals"), "Monthly Vol Actual", xlSum
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("Monthly $/SU Actuals"), "Monthly $/SU Actual", xlSum
ActiveWorkbook.ShowPivotTableFieldList = False
When setting the PRange you can use Cells.SpecialCells method to set your range even though you don't always know what that end address will be as long as you're sure you won't have extra data somewhere below/beyond your target range.
It would look something like this:
Set PRange = DSheet.Range(DSheet.Cells(1, 27), DSheet.Cells.SpecialCells(xlCellTypeLastCell))
Also, it is a matter of personal style, but I find that nesting With blocks sometimes results in more readable code. Eg:
With ActiveSheet.PivotTables("PivotTable1")
With .PivotFields("Field 1")
.Caption = "My first field"
.Function = xlSum
End With
With .PivotFields("Field 2")
.Caption = "My second field"
.Function = xlMax
End With
End With
etc.
The final product looks something like this:
Dim DSheet As Worksheet ', PSheet As Worksheet
Dim PCache As PivotCache, PTable As PivotTable, PRange As Range
'Dim LastRow As Long, LastCol As Long
'Application.DisplayAlerts = False ' This is redundant since you're setting it to true below.
Application.DisplayAlerts = True
'Set PSheet = Worksheets("Budget_Report") '
Set DSheet = Worksheets("Budget_Report") ' These two are Redundant - I am using only DSheet.
'LastRow = DSheet.Cells(Rows.Count, 27).End(xlUp).Row
'LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Range(Cells(1, 27),Cells.SpecialCells(xlCellTypeLastCell))
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=DSheet.Cells(9, 1), TableName:="PivotTable")
With ActiveSheet.PivotTables("PivotTable")
With .PivotFields("T-Lane")
.Orientation = xlRowField
.Position = 1
.Subtotals(1) = True ' You're resetting this value in the next line, you can probably remove it.
.Subtotals(1) = False
End With
With .PivotFields("Monthly Cost FCST")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.Caption = "Monthly Cost Forecast" 'You want .Caption here, not .Name
End With
With .PivotFields("Monthly Vol FCST")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
.Caption = "Monthly Vol Forecast"
End With
With .PivotFields("Monthly $/SU FCST")
.Orientation = xlDataField
.Position = 3
.Function = xlSum
.Caption = "Monthly $/SU Forecast"
End With
With .PivotFields("Monthly Cost Actuals")
.Orientation = xlDataField
.Position = 4
.Function = xlSum
.Caption = "Monthly Cost Actual"
End With
With .PivotFields("Monthly Vol Actuals")
.Orientation = xlDataField
.Position = 5
.Function = xlSum
.Caption = "Monthly Vol Actual"
End With
With .PivotFields("Monthly $/SU Actuals")
.Orientation = xlDataField
.Position = 6
.Function = xlSum
.Caption = "Monthly $/SU Actual"
End With
End With
It appears that you try to create the same table twice:
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="PivotTable")
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(9, 1), TableName:="PivotTable")
Just split it in two:
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(9, 1), TableName:="PivotTable")
Assign to PCache only Cache:
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)