The below is the code that I have used. I want to fix my chart numbers of this and the other charts that I have created so that I can format them later. Also if someone can suggest how to shorten up the code.
'Declare Variables
Dim PCache7 As PivotCache
Dim PTable7 As PivotTable
'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 PCache7 = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 12), _
TableName:="AnalyticsPivotTable7")
'Insert Blank Pivot Table
Set PTable7 = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(2, 12), TableName:="AnalyticsPivotTable7")
'Insert Row Fields
With ActiveSheet.PivotTables("AnalyticsPivotTable7").PivotFields("Issue Type")
.Orientation = xlRowField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("AnalyticsPivotTable7").PivotFields("IncidentID")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.NumberFormat = "#,##0"
End With
'Insert Data Field
With ActiveSheet.PivotTables("AnalyticsPivotTable7").PivotFields("IncidentID")
.Orientation = xlDataField
.Position = 2
.Function = xlCount
.Calculation = xlPercentOfTotal
.NumberFormat = "#0.0%"
End With
'Format Pivot Table
ActiveSheet.PivotTables("AnalyticsPivotTable7").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("AnalyticsPivotTable7").TableStyle2 = "PivotStyleMedium9"
Range("N4:N16").Select
ActiveSheet.PivotTables("AnalyticsPivotTable7").PivotFields("Issue Type"). _
AutoSort xlDescending, "Count of IncidentID2", ActiveSheet.PivotTables( _
"AnalyticsPivotTable7").PivotColumnAxis.PivotLines(2), 1
Related
I have a pivot table with 111 headers or fields and i am trying to create a pivot table with 1 header as row field and 5 headers as value fields.
I am able to fetch 1 row field but for value fields i am able to fetch 1 field only and remaining 4 fields are not fetching.
Please note headers are in row 14.
I tried below code until now.
Sub Pivot()
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
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Options")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(14, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(14, 1).Resize(LastRow, LastCol)
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 1), _
TableName:="PivotTable")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
With ActiveSheet.PivotTables("PivotTable").PivotFields("Client")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Final Base")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "#,##0"
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Sum of Green")
.Orientation = xlDataField
.Function = xlSum
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Sum of Amber)")
.Orientation = xlDataField
.Function = xlSum
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable").addPivotFields("Sum of Toll)")
.Orientation = xlDataField
.Function = xlSum
.Position = 4
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Sum of Red)")
.Orientation = xlDataField
.Function = xlSum
.Position = 5
End With
ActiveSheet.PivotTables("PivotTable").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("PivotTable").TableStyle2 = "PivotStyleMedium9"
End Sub
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
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 run the same reports every day and would like to use a generic VBA code that selects all my data and creates the pivot table. I've recorded the MACRO:
I need the data range selected automatically to be allow any data amount
I need the data range to be selected automatically
The sheet should not matter
Finally I would like to name the sheet
code:
Sheets.Add
ActiveWorkbook.Worksheets("Sheet1").PivotTables("PivotTable26").PivotCache. _
CreatePivotTable TableDestination:="Sheet4!R3C1", TableName:="PivotTable27" _
, DefaultVersion:=xlPivotTableVersion15
Sheets("Sheet4").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable27").PivotFields("Date Opened")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable27").PivotFields("Date Opened")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable27").PivotFields("Queue")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable27").PivotFields("Sub Queue")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable27").PivotFields("Status")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable27").AddDataField ActiveSheet.PivotTables( _
"PivotTable27").PivotFields("Source"), "Count of Source", xlCount
With ActiveSheet.PivotTables("PivotTable27").PivotFields("Queue")
.PivotItems("(blank)").Visible = False
End With
End Sub
Here's a little code to get you what you asked in your post:
Option Explicit
Sub AutoPivot()
Dim PT As PivotTable
Dim PTCache As PivotCache
Dim PtDataRng As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Set ws = Worksheets("PivotData") ' <-- modify "PivotData" to your sheet's name that holds the dynamic data
With ws
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column ' <-- get last column with data in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlToLeft).Row ' <-- get last row with data in column A
Set PtDataRng = .Range(.Cells(1, 1), .Cells(LastRow, LastCol)) ' <-- set the dynamic Range
End With
' create a new wroksheet, place it at the end, and use an InputBox to select it's name
Set ws = ThisWorkbook.Sheets.Add(after:=Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Application.InputBox("Select A Valid Name for new sheet", Type:=2)
' set the Pivot Cache to updated dynamic Ranget
Set PTCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PtDataRng)
' Create Pivot Table from Pivot Cache
Set PT = ws.PivotTables.Add(PivotCache:=PTCache, TableDestination:=ws.Range("A3"), TableName:="PivotTableTest")
' set the fields setting in the Pivot Table
With PT
With .PivotFields("Date Opened")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Date Opened")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Queue")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Sub Queue")
.Orientation = xlRowField
.Position = 2
End With
With .PivotFields("Status")
.Orientation = xlColumnField
.Position = 1
End With
.AddDataField .PivotFields("Source"), "Count of Source", xlCount
With .PivotFields("Queue")
.PivotItems("(blank)").Visible = False
End With
End With
End Sub
I'm trying to create a Pivot table, but getting Invalid Procedure Call or Argument.
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="rng", Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:="rngB", TableName:="pvtReportA_B", DefaultVersion:=xlPivotTableVersion14
rng (The source) is a range consisting of about 20 columns and a few thousand rows.
rngB (The destination) is a single cell in a different worksheet
Can anyone advise where I am going wrong?
EDIT:
My fault, I should have been using rngData and not rng as the Source.
Set rng = wsA.Range("C14")
Set rngData = Range(rng, rng.End(xlToRight))
Set rngData = Range(rng, rng.End(xlDown))
Set rngB = wsB.Range("C8")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData, Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:=rngB, TableName:="pvtReportA_B", DefaultVersion:=xlPivotTableVersion14
This brings up the PivotTable frame just fine.
In this instance, I used the wrong range object, which caused Excel to throw a fit.
Set rng = wsA.Range("C14")
Set rngData = Range(rng, rng.End(xlToRight))
Set rngData = Range(rng, rng.End(xlDown))
Set rngB = wsB.Range("C8")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData, Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:=rngB, TableName:="pvtReportA_B", DefaultVersion:=xlPivotTableVersion14
To create a pivot in Excel 2010, using VBA code, you can use and adapt this template:
Sub newPVT()
Dim PTCache As PivotCache
Dim PT As PivotTable
'Create the Cache
Set PTCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Range("Dynamic_Field_Summary"))
'Select the destination sheet
Sheets("Field Summary").Select
'Create the Pivot table
Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, _
TableDestination:=Range("P1"), TableName:="Pivot1")
ActiveWorkbook.ShowPivotTableFieldList = True
'Adding fields
With PT
With .PivotFields("Enterprise")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Field")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Planted Acres")
.Orientation = xlDataField
.Position = 1
.Caption = " Planted Acres"
.Function = xlSum
End With
With .PivotFields("Harvested Acres")
.Orientation = xlDataField
.Position = 2
.Caption = " Harvested Acres"
.Function = xlSum
End With
With .PivotFields("lbs")
.Orientation = xlDataField
.Position = 3
.Caption = " lbs"
.Function = xlSum
End With
'Adjusting some settings
.RowGrand = False
.DisplayFieldCaptions = False
.HasAutoFormat = False
'Improving the layout
.TableStyle2 = "PivotStyleMedium9"
.ShowTableStyleRowStripes = True
.ShowTableStyleColumnStripes = True
End With
With ActiveSheet
'Adjusting columns width
.Columns("P:V").ColumnWidth = 16
.Range("Q2:V2").HorizontalAlignment = xlCenter
End With
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub
I found it here.
In this page you can also fine the meaning of every part of the code, for example is explained here.
I think that this is a good code also to start creating vba macros for Excel 2007 or other versions.