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
Related
So what I am trying to do is filtering the MEMBERS which have a value greater than > 5000 (threshhold of 5000) using VBA
But weirdly, it's not working..
Any type of solution is welcome !
Here is my code :
Sub Filterthreshhold()
Dim PSheet As Worksheet, DSheet As Worksheet, PCache As PivotCache, pvt As PivotTable, PRange As Range, lastRow As Long, LastCol As Long, pvtField As PivotField, threshhold As Double
Application.ScreenUpdating = False
'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("Prestations")
'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:="PoolPivotTable")
'Insert Blank Pivot Table
Set pvt = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PoolPivotTable")
Sheets("PivotTable").Name = "MEC"
'Insert Filter Fields
With ActiveSheet.PivotTables("PoolPivotTable").PivotFields("CODE")
.Orientation = xlPageField
.Position = 1
End With
'Insert Row Fields
With ActiveSheet.PivotTables("PoolPivotTable").PivotFields("PROV")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PoolPivotTable").PivotFields("MEMBRE")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PoolPivotTable").PivotFields("PAYEE")
.Orientation = xlRowField
.Position = 3
End With
'Insert Data Fields
With ActiveSheet.PivotTables("PoolPivotTable").PivotFields("SommeDeSANTE")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "#,###.##"
.Name = "Santé"
End With
'Threshold
pvt.ClearAllFilters
Set pvtField = pvt.PivotFields("Sum of Santé")
With ActiveSheet.PivotTables("PoolPivotTable").PivotFields("MEMBRE")
pvtField.PivotFilters.Add xlValueIsGreaterThanOrEqualTo, Value1:=5000
End With
'I have also tried .PivotFilters.Add2
Application.ScreenUpdating = True
End Sub
With ActiveSheet.PivotTables("PoolPivotTable").PivotFields("MEMBRE")
pvtField.PivotFilters.Add2 Type:= xlValueIsGreaterThanOrEqualTo, DataField:=ActiveSheet.PivotTables("PoolPivotTable"). _
PivotFields("Sum of Santé"),Value1:=5000
End With
You might be missing the data field of your sum
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 am trying to create a fairly simple pivot table, but I have trouble dealing with pivot cache creation. Both data source and data type seem to be correct yet I get an error. I searched for similar issues but none of the verified answers worked for me.
Sub Macro1()
'
' Macro1 Macro
'
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("Regions").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Regions"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Regions")
Set DSheet = Worksheets("Sheet1")
'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)
'Set Pivot table Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2),TableName:="SalesPivotTable")
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="SalesPivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("ID")
.Orientation = xlRowField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Pkt avg")
.Orientation = xlDataField
.Position = 1
.Function = xlAverage
.NumberFormat = "0"
.Name = "pkt avg"
End With
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Number of apt")
.Orientation = xlDataField
.Position = 2
.Function = xlCount
.NumberFormat = "0"
.Name = "Apt num"
End With
End Sub
I get the type mismatch error here Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(2, 2),TableName:="SalesPivotTable")
Try
Sub Macro1()
'
' Macro1 Macro
'
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("Regions").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Regions"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Regions")
Set DSheet = Worksheets("Sheet1")
'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)
'Set Pivot table Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="SalesPivotTable")
'Insert Row Fields
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("ID")
.Orientation = xlRowField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Pkt avg")
.Orientation = xlDataField
.Position = 1
.Function = xlAverage
.NumberFormat = "0"
'.Name = "Pkt avg"
.Caption = "Pkt Avgs" '~~> can't use same name with field name
End With
With ActiveSheet.PivotTables("SalesPivotTable").PivotFields("Number of apt")
.Orientation = xlDataField
.Position = 2
.Function = xlCount
.NumberFormat = "0"
'.Name = "Apt num"
.Caption = "Apt num"
End With
Application.DisplayAlerts = False
End Sub
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
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