My code for doing a Pivot Table doesn't actually do anything. It just creates a new sheet, but not the pivot table.
In my workbook I will be having 2 sheets: one with the data and one with the pivot table.
This is my code:
Sub InsertPivotTable()
'Macro By ExcelChamps
'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("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("DATA")
'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:="Pivot_table")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="Pivot_table")
With ActiveSheet.PivotTables("Pivot_table").PivotFields("data1")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("Pivot_table").AddDataField ActiveSheet.PivotTables( _
"Pivot_table").PivotFields("data2"), "Count of data2", xlCount
'Format Pivot Table
ActiveSheet.PivotTables("Pivot_table").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("Pivot_table").TableStyle2 = "PivotStyleMedium9"
End Sub
Related
I cant quite figure out how to filter my created pivot table with vba. The filter syntax I'm trying to use is the last line. I'm currently creating a pivot table from a raw data tab then trying to filter out the (blank) items.
I've tried (blank), 0, "" for the criteria
Sub Test()
'Pivot Table
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 copyRng As Range
Dim destRng As Range
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("START")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).row
LastCol = DSheet.Cells(7, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(7, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), _
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("EmpID")
.Orientation = xlRowField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("PivotTable").PivotFields("DistinctCount")
.Orientation = xlDataField
.Position = 2
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "DistinctReferenceCount"
End With
'Format Pivot
TableActiveSheet.PivotTables("PivotTable").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("PivotTable").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.PivotTables("PivotTable").RowAxisLayout xlOutlineRow
ActiveSheet.PivotTables("PivotTable").RepeatAllLabels xlRepeatLabels
Worksheets("PivotTable").Range("A1").AutoFilter Field:=3, Criteria1:="<>(blank)"
End Sub
Some improvements to your code, study them
Option Explicit
Sub Test()
On Error GoTo Err_Control
'Pivot Table
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 copyRng As Range
Dim destRng As Range
'Application.DisplayAlerts = False
'Worksheets("PivotTable").Delete
'Sheets.Add Before:=ActiveSheet
'ActiveSheet.Name = "PivotTable"
'----To Recreat your sheet....
Dim wrk As ThisWorkbook
Dim sht As Worksheet
Set wrk = ThisWorkbook
Dim trg As Worksheet
Dim Existe As Byte
For Each sht In wrk.Worksheets
If sht.Name = "PivotTable" Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets("PivotTable").Delete
Application.DisplayAlerts = True
End If
Next sht
Application.ScreenUpdating = False
Existe = 0
For Each sht In wrk.Worksheets
If sht.Name = "PivotTable" Then
Existe = 1
End If
Next sht
If Existe = 0 Then
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = "PivotTable"
End If
'-----------------------------------------
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("START")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(7, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(7, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange, Version:=6). _
CreatePivotTable TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable", DefaultVersion:=6
'Insert Blank Pivot Table ' Don't need that, lines over create pivot table
'Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("EmpID")
.Orientation = xlRowField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("PivotTable").PivotFields("DistinctCount")
.Orientation = xlDataField
'.Position = 2 'Don't need that, generates error
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "DistinctReferenceCount"
End With
'Format Pivot Table
ActiveSheet.PivotTables("PivotTable").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("PivotTable").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.PivotTables("PivotTable").RowAxisLayout xlOutlineRow
ActiveSheet.PivotTables("PivotTable").RepeatAllLabels xlRepeatLabels
ActiveSheet.PivotTables("PivotTable").PivotFields("DistinctCount").PivotItems("(blank)").Visible = False
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
'here you handle the errors, if an error appears,
'press Ctrl + Pause Break that you can go to the error location using
'resume next
'below this msgbox err.description
End If
End Sub
This question already has an answer here:
Type mismatch during creation of pivot table : Excel vba
(1 answer)
Closed 2 years ago.
When trying to run this code, I continue to get
run time error 13 "Type Mismatch"
when setting the pivot Cache and I am not sure what is causing the issue. I have tried both PivotCaches.Add and PivotCaches.Create and both give the same error. Any Ideas?
Sub NEWPIVOTERROR()
'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
' Assembly Engineer
Sheets("Assembly Engineer").Activate
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Assembly Engineer Charts"
Set PSheet = Worksheets("Assembly Engineer Charts")
Set DSheet = Worksheets("Assembly Engineer")
'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.Add _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="AssemblyEngineerPivotTable")
'?Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="AssemblyEngineerPivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("AssemblyEngineerPivotTable").PivotFields("Task Owner2")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("AssemblyEngineerPivotTable").PivotFields("Type")
.Orientation = xlColumnField
.Position = 1
End With
'Insert Data Field
ActiveSheet.PivotTables("AssemblyEngineerPivotTable").AddDataField ActiveSheet.PivotTables("AssemblyEngineerPivotTable").PivotFields("Type")
End Sub
Sub NEWPIVOTERROR()
'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
' Assembly Engineer
Sheets("Assembly Engineer").Activate 'Edit
Application.DisplayAlerts = False
Worksheets("Assembly Engineer Charts").Delete 'Edit
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Assembly Engineer Charts" 'Edit
Application.DisplayAlerts = True
Set PSheet = Worksheets("Assembly Engineer Charts") 'Edit
Set DSheet = Worksheets("Assembly Engineer") 'Edit
'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:="AssemblyEngineerPivotTable") 'Edit
'?Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="AssemblyEngineerPivotTable") 'Edit
'Insert Row Fields
With ActiveSheet.PivotTables("AssemblyEngineerPivotTable").PivotFields("Task Owner2") 'Edit
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("AssemblyEngineerPivotTable").PivotFields("Type") 'Edit
.Orientation = xlColumnField
.Position = 1
End With
'Insert Data Field
ActiveSheet.PivotTables("AssemblyEngineerPivotTable").AddDataField ActiveSheet.PivotTables("AssemblyEngineerPivotTable").PivotFields("Type") 'EditX2
End Sub
Using a Range object doesn't work well with big datasets. Use the address instead:
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:="'" & DSheet.Name & "'!" & PRange.Address(Referencestyle:=xlr1c1)). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="AssemblyEngineerPivotTable")
I have created a macro code where in only one pivot table gets created, can some one help me in creating mutilple pivot table in single sheet.
The below code i am using, here the filter selects only for india, in next H column i want the same pivot table where in it selects EMEA
and in next Q column the filter selects others
code:
Sub pivottable()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache1 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 PSheet = Worksheets("PivotTable2")
Set DSheet = Worksheets("Raw 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). _
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("Region")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable").PivotFields("Region").CurrentPage = _
"INDIA"
With ActiveSheet.PivotTables("PivotTable").PivotFields("Assignment Group")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Aging")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables( _
"PivotTable").PivotFields("Number"), "Count of Number", xlCount
ActiveSheet.PivotTables("PivotTable").PivotFields("Assignment group"). _
AutoSort xlDescending, "Count of Number"
End Sub
I have amended some code I found on the internet which I am trying to use to create a pivot table. I have used code name for one worksheet because it will be used on multiple workbooks whose sheet name will be different.
When I run the below code it creates a pivot table but with just the area as a lone column
What I want is surnames for rows and account codes for balances with a total at the end of each row.
Please see code, and help me get this to populate the rows properly.
Sub InsertPivotTable()
'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("byAccount").Delete
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "byAccount"
Application.DisplayAlerts = True
Set PSheet = Worksheets("byAccount")
Set DSheet = Worksheets(1)
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 4).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(4, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), _
TableName:="byAccountPivot")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="byAccountPivot")
'Insert Row Fields
With ActiveSheet.PivotTables("byAccountPivot").PivotFields("Surname")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("byAccountPivot").PivotFields("Account Code")
.Orientation = xlRowField
.Position = 2
End With
'Insert Column Fields
With ActiveSheet.PivotTables("byAccountPivot").PivotFields("Amount")
.Orientation = xlColumnField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("byAccountPivot")
.PivotFields ("Amount")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
.Name = "Amount"
End With
'Format Pivot Table
ActiveSheet.PivotTables("byAccountPivot").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("byAccountPivot").TableStyle2 = "PivotStyleMedium9"
End Sub
Thanks to anyone who may have been looking at this but I have fixed this now please see amended code below.
Sub createPivot()
Dim PSheet As Worksheet, 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("by Account").Delete
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "by Account"
Set PSheet = Worksheets("by Account")
Set Dsheet = Sheets(1)
lastRow = Sheet6.UsedRange.Row + Sheet6.UsedRange.Rows.Count - 4
lastCol = Sheet6.UsedRange.Column + Sheet6.UsedRange.Columns.Count - 1
Set pRange = Dsheet.Cells(4, 1).Resize(lastRow, lastCol)
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
pRange, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=PSheet.Cells(1, 1), TableName:="byAccountPivotTable", _
DefaultVersion:=xlPivotTableVersion14
ActiveSheet.PivotTables("byAccountPivotTable").AddDataField ActiveSheet.PivotTables( _
"byAccountPivotTable").PivotFields("Amount"), "Sum of Amount", xlSum
With ActiveSheet.PivotTables("byAccountPivotTable").PivotFields("Account Code")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("byAccountPivotTable").PivotFields("Surname")
.Orientation = xlRowField
.Position = 1
End With
End Sub
I am creating a macro which automates creating a pivot table. I am able to get an output for the pivot table, but all the data values are #N/A. This is due to the column that I utilize in the pivot table that contain values of #N/A.
How do I get the actual summation for all rows, without having to temper with the data set? This is the code that I am using so far.
Sub pivottable()
Dim PSheet As Worksheet, DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PField As PivotField
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim PvtTable As pivottable
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(1)
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(4, 1), _
TableName:="PivotTable4")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
Sheets("PivotTable").Select
Set PvtTable = ActiveSheet.PivotTables("PivotTable")
'Rows
With PvtTable.PivotFields("Office")
.Orientation = xlRowField
.Position = 1
End With
With PvtTable.PivotFields("Type")
.Orientation = xlRowField
.Position = 2
End With
'Columns
With PvtTable.PivotFields("Category")
.Orientation = xlColumnField
.Position = 1
End With
PvtTable.AddDataField PvtTable.PivotFields("Receipts"), "receipts", xlSum
End Sub
I read that it might be possible to use AutoFilter . Would AutoFilter be able to ignore data with #N/A values or "0" and carry on summing other values, so we avoid having #N/A in our pivot table.
Wrap your VLOOKUP function in an IFERROR function, so that #N/A values are not returned in your source data.