I am creating a simple Pivot table by VBA. I don't know what is wrong with my code. My code runs without error but the results is different. Could you please tell me where is the problem in my code.
Sub CreatePivotTable()
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
'Determine the data range you want to pivot
SrcData = ActiveSheet.Name & "!" & Range("A1:B53821").Address(ReferenceStyle:=xlR1C1)
'Create a new worksheet
Set sht = Sheets.Add
'Where do you want Pivot Table to start?
StartPvt = sht.Name & "!" & sht.Range("A1").Address(ReferenceStyle:=xlR1C1)
'Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData)
'Create Pivot table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable(TableDestination:=StartPvt, TableName:="PivotTable1")
pvt.PivotFields("Module").Orientation = xlRowField
pvt.PivotFields("KW").Orientation = xlColumnField
pvt.AddDataField pvt.PivotFields("Module"), "Anzahl von Module", xlCount
pvt.PivotFields("Module").PivotFilters.Add Type:=xlTopCount, DataField:=pvt.PivotFields("Anzahl von Module"), Value1:=12
End Sub
If I do it manually, this is the result I get and this is what I want at the end.
My code gives me this result. Which is wrong.
I think your problem is in your small initial range with only two columns (A, B) and the last lines of code
'Determine the data range you want to pivot
SrcData = ActiveSheet.Name & "!" & Range("A1:B53821").Address(ReferenceStyle:=xlR1C1)
Let's suppose you have your name in column A, call Module and column B is KW with a number (the KW/h of your module)
'Create Pivot table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable(TableDestination:=StartPvt, TableName:="PivotTableTest")
pvt.AddDataField pvt.PivotFields("Module"), "Num Module", xlCount
pvt.PivotFields("Module").Orientation = xlColumnField ' not xlRowField
pvt.PivotFields("KW").Orientation = xlRowField ' not xlColumnField
You don't need the last line.
Try adding the xlRowField and xlColumnField after you added the calculated field.
e.g.
first
pvt.AddDataField pvt.PivotFields("Module"), "Anzahl von Module", xlCount
then
pvt.PivotFields("Module").Orientation = xlRowField
pvt.PivotFields("KW").Orientation = xlColumnField
Related
Sub CreatePivot()
Dim NewSheet As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PTRange As Range
Dim FinalRow As Long
Dim FinalCol As Long
Set NewSheet = Workbooks("東京威力_樞紐分
析.xlsm").Sheets.Add(Before:=Workbooks("東京威力_樞紐分
析.xlsm").Worksheets(1))
NewSheet.Name = "Summary"
For Each PT In NewSheet.PivotTables
PT.TableRange2.Clear
Next PT
Set PTRange = getTable("Table1").Range
'Create PivotCaches
Set PTCache = Workbooks("東京威力_樞紐分
析.xlsm").PivotCaches.Create(SourceType:=xlDatabase,
SourceData:=PTRange.Address)
'Create PivotTable
Set PT =
PTCache.CreatePivotTable(TableDestination:=NewSheet.Cells(2,
2),tableName:="PivotTable1")
'ManualUpdate On
PT.ManualUpdate = True
PT.AddFields RowFields:=Array("Recharge BU", "Main Category"),
ColumnFields:="Recharge To"
With PT.PivotFields("Hours")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "#,##0.00"
.Name = "Total - Hours"
End With
'Calcu PivotTable
PT.ManualUpdate = False
PT.ManualUpdate = True
End Sub
-------------------------------------------------------------------------
Function getTable(tableName As String) As ListObject
Dim FinalRow As Long
With Workbooks("東京威力_樞紐分析.xlsm").Worksheets("原始資料")
On Error GoTo ErrorHandler
FinalRow = .Cells(Rows.Count, 1).End(xlUp).row
Set getTable = .ListObjects(tableName)
End With
Exit Function
ErrorHandler:
Debug.Print Err.Number; ":" & Err.Description
If getTable Is Nothing Then
Workbooks("東京威力_樞紐分析.xlsm").Worksheets("原始資料").ListObjects.Add(xlSrcRange,
Workbooks("東京威力_樞紐分析.xlsm").Worksheets("原始資料").Range("A1:AK" & FinalRow), , xlYes).Name = "Table1"
Set getTable = Worksheets("原始資料").ListObjects(tableName)
End If
Resume Next
End Function
Hi Folks, the Purpose of the code is to create pivot table.
But I Got Error Message
『The PivotTable field name is not valid. To create a PivotTable report, you must use data that is organized as a list with labeled columns. If you are changing the name of a PivotTable field, you must type a new name for the field』 when I created Pivot Table. (at the line==> PTCache.CreatePivotTable)
What could possibly go wrong ? Thanks
PS : I can manually create pivot table from same data source.
SourceData:=PTRange.Address will give us the cell address without the sheet name, e.g. $C$7:$G$17. This do not work for PT.
SourceData requires range reference with sheet name, e.g.
Therefore, it should be
SourceData:= PTRange.Parent.Name & "!" & PTRange.Address. But if your sheet name contain spaces, then it should be SourceData:= "'" & PTRange.Parent.Name & "'!" & PTRange.Address.
Since your data is contained in named-range Table1, using the name as the SourceData will be much much easier.
I receive the error when set the pivot cache. I.e at this line:-
Set pvt = pvtCache.CreatePivotTable(TableDestination:=StartPvt, TableName:="PivotTable2")
I have used this macro in another workbook and I have not received this error.
Sub PivTable()
'
' Insert a pivot table
'
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
Dim ws As Worksheet
Dim x As Long
Set ws = Worksheets("Cash Month End")
With ws
x = .Range("b999999").End(xlUp).Row
End With
'Data Range to pivot
SrcData = "Cash Month End!(R4C1:R" & x & "C24)"
' Insert Sheet
Sheets.Add.Name = "Cash Pivot"
'Where the pivot must start
StartPvt = "Cash Pivot!R3C1"
'Create the pivot cache
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData)
'Create Pivot Table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable(TableDestination:=StartPvt, TableName:="PivotTable2")
'Add fields
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Segment")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("No."), "Sum of No", xlSum
End Sub
I am trying to create a Pivot table on a newsheet using dynamic range, but getting an error that says:
Run time error: 13 Type Mismatch
Googled the error and as per my understanding, the code contains data type that is not matched correctly, but I am not able to figure out where is the error:
Using Excel 2016.
Sub EEE()
Dim PrevSheet As Worksheet
Set PrevSheet = ActiveSheet
Sheets.Add.Name = "Pivottable"
PrevSheet.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ActiveSheet.UsedRange, _
Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Pivottable!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion15
Sheets("Pivottable").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Faculty")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("NPS")
.Orientation = xlColumnField
.Position = 1
End With
End Sub
Modified Code - Working
Sub EEE()
Dim rng As Range
Dim pc As PivotCache
Dim pt As PivotTable
Dim ws As Worksheet
Set rng = ActiveSheet.Range("A1").CurrentRegion
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabaseSourceData:=rng.Address)
Set ws = ActiveWorkbook.Worksheets.Add
ws.Name = "NewSheet"
Set pt = pc.CreatePivotTable(TableDestination:=Range("A3"),TableName:="pvttbl")
With pt
.PivotFields("Faculty").Orientation = xlRowField
ActiveSheet.PivotTables("pvttbl").AddDataField ActiveSheet.PivotTable "pvttbl").PivotFields("NPS"), "Count of NPS", xlCount
.PivotFields("NPS").Orientation = xlColumnField
End With
End Sub
You don't say what line is giving the error. But there's a couple of possible culprits.
The line SourceData:=ActiveSheet.UsedRange says "Hey, go make the PivotTable out of everything you find on the active sheet". Not a good idea. Use the exact range where the data is. Either select a cell where there block of data is and use the CurrentRegion e.g.
SourceData:= Activesheet.Range("A1").CurrentRegion
...or even better, turn that SourceData into an Excel Table aka ListObject earlier in the code, and reference that ListObject:
SourceData:= "Table1"
Your code will also fail if you try to run it more than once and you haven't deleted the sheet called "PivotTable" that it created last time.
Here's how I would code this up:
Option Explicit
Sub EEE()
Dim rng As Range
Dim pc As PivotCache
Dim pt As PivotTable
Dim pf As PivotField
Dim ws As Worksheet
Set rng = Range("A1").CurrentRegion '<- Change to the address of the top left cell in your data.
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng.Address)
Set ws = ActiveWorkbook.Worksheets.Add
Set pt = pc.CreatePivotTable(TableDestination:=Range("A1"))
With pt
.PivotFields("Faculty").Orientation = xlRowField
.PivotFields("NPS").Orientation = xlColumnField
End With
End Sub
OBJECTIVE
Sort Pivot Table Values by Descending order.
APPROACH
Delete previous PivotTable (PIVOT)
Set up new PivotTable location (target)
Create PivotCache (pvtCache)
Deply PivotTable (pvt)
Add PivotTable Fields (pvt.PivotFields(_))
ISSUE: Sort PivotTable field (PivotField("Base Expense")) in descending order
CODE
Sub createPivot()
Dim ws As Worksheet
Dim pvtCache As pivotCache
Dim pvt As pivotTable
Dim srcData As String
Dim lastRow As Long
Dim startPvt As String
Dim target As Worksheet
'Delete previous pivottable
Worksheets("PIVOT").PivotTables("PivotTable1").TableRange2.Clear
'Select pivot table data
Worksheets("CONSOLIDATED").Activate
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
srcData = ActiveSheet.Name & "!" & Range("A1:H" & lastRow).Address(ReferenceStyle:=xlR1C1)
'Set pivot table location
Set target = ThisWorkbook.Worksheets("PIVOT")
startPvt = target.Name & "!" & target.Range("A1").Address(ReferenceStyle:=xlR1C1)
'Create pivot cache
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=srcData)
'Deploy pivot table
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=startPvt, _
TableName:="PivotTable1")
'Add Pivot Fields
pvt.PivotFields("Fiscal Year").Orientation = xlColumnField
pvt.PivotFields("Fiscal Year").Position = 1
pvt.PivotFields("Fiscal Month").Orientation = xlColumnField
pvt.PivotFields("Fiscal Month").Position = 2
pvt.PivotFields("Unit").Orientation = xlRowField
pvt.PivotFields("Unit").Position = 1
pvt.PivotFields("Project").Orientation = xlRowField
pvt.PivotFields("Project").Position = 2
pvt.PivotFields("Base Expense").Orientation = xlDataField
'Sort by largest !!!ERROR!!!
pvt.PivotField("Base Expense") _
.AutoSort xlDescending, "Base Expense"
End Sub
ERROR
"Object doesn't support this property or method"
# Line
'Sort by largest !!!ERROR!!!
pvt.PivotField("Base Expense") _
.AutoSort xlDescending, "Base Expense"
QUESTIONS
Unsure why this error is being thrown. I've searched documentation that leads me to believe this should work (https://msdn.microsoft.com/en-us/library/office/ff834371.aspx) NOTE: ActiveSheet != to the sheet the pivot table is on, but I dont think that should create an issue here
Any recommendations on code-refactoring is appreciated.
The problem you are having is that you are trying to sort the values in the data field. It doesn't know which other field to sort by.
The PivotField that you want to run the AutoSort method on is the field that you want sorted. The Field parameter of the method is the key that you want to sort it on.
In this case, you want something like this:
pvt.PivotField("Project") _
.AutoSort xlDescending, "sum of Base Expense"
I am trying to create a pivot table on a new sheet. Additionally, I would like to create another call to create another different pivot table using the same data from the first data sheet.
having trouble with the macro below. I think it is a small error, but can't figure it out.
Sub Macro2()
Dim FinalRow As Long
Dim DataSheet As String
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
Dim DataRng As Range
Dim TableDest As Range
Dim ws As Worksheet
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
DataSheet = ActiveSheet.Name
'set data range for Pivot Table -- ' conversion of R1C1:R & FinalRow & C15
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15))
Set ws = Worksheets.Add
ws.Name = "Travel Payment Data by Employee"
'set range for Pivot table placement -- Conversion of R1C1
Set TableDest = Sheets("Travel Payment Data by Employee").Cells(1, 1)
Set PvtCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, DataRng, xlPivotTableVersion15)
'check if "PivotTable4" Pivot Table already created (in past runs of this Macro)
Set PvtTbl = ActiveWorkbook.Sheets("Travel Payment Data by Employee").PivotTables("PivotTable4")
With PvtTbl.PivotFields("Security Org")
.Orientation = xlRowField
.Position = 1
End With
With PvtTbl.PivotFields("Fiscal Month")
.Orientation = xlRowField
.Position = 2
End With
With PvtTbl.PivotFields("Budget Org")
.Orientation = xlRowField
.Position = 3
End With
With PvtTbl.PivotFields("Vendor Name")
.Orientation = xlRowField
.Position = 4
End With
With PvtTbl.PivotFields("Fiscal Year")
.Orientation = xlRowField
.Position = 5
End With
With PvtTbl.PivotFields("Fiscal Year")
.Orientation = xlColumnField
.Position = 1
End With
PvtTbl.AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum
End Sub
Consider the following adjustment with a subroutine calling a function, passing in new worksheet names for new identical pivot tables. If you do not intend identical pivots, adjust them in code conditionally by sheet name or copies of function. The main changes from your code are as follows:
ACTIVE SHEET: Remove the need to search ActiveSheet.Name as adding more worksheets will alter active sheets. Simply hard-code or pass as parameter the data source.
OBJECT CHECK: You need to check if Worksheet exits and PivotTable exists. For these, you will need to iterate through all current such objects and conditionally set worksheet, pivot table objects (see For...Next loops and If ... Is Nothing checks).
For PivotField, since Dollar Amounts will exist in Pivot Table data source but not necessarily display, iterating through all of them might not work like above. So conditionally add only if does not error out see On Resume Next handle.
VBA
Option Explicit
Public Sub RunPivots()
Call BuildPivot("Travel Payment Data by Employee")
Call BuildPivot("Other Worksheet")
Call BuildPivot("Still More Worksheet")
End Sub
Function BuildPivot(paramSheet As String)
On Error GoTo ErrHandle
Dim FinalRow As Long
Dim DataSheet As String
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
Dim PvtFld As PivotField
Dim DataRng As Range
Dim TableDest As Range
Dim ws As Worksheet
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
DataSheet = "DataSourceWorksheet"
' set data range for Pivot Table
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15))
' check if worksheet exists
Dim currws As Worksheet
For Each currws In ActiveWorkbook.Worksheets
If currws.Name = paramSheet Then
Set ws = Worksheets(paramSheet)
Exit For
End If
Next currws
' create new worksheet if does not exist
If ws Is Nothing Then
Set ws = Worksheets.Add
ws.Name = paramSheet
End If
' set range for Pivot table placement
Set TableDest = Sheets(paramSheet).Cells(1, 1)
' create pivot cache
Set PvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=DataRng, _
Version:=xlPivotTableVersion15)
'check if "PivotTable4" Pivot Table exists
Dim currpvt As PivotTable
For Each currpvt In ws.PivotTables
If currpvt.Name = "PivotTable4" Then
Set PvtTbl = ws.PivotTables("PivotTable4")
Exit For
End If
Next currpvt
' create new pivot table if does not exist
If PvtTbl Is Nothing Then
Set PvtTbl = PvtCache.CreatePivotTable( _
TableDestination:=TableDest, _
TableName:="PivotTable4")
End If
With PvtTbl.PivotFields("Security Org")
.Orientation = xlRowField
.Position = 1
End With
With PvtTbl.PivotFields("Fiscal Month")
.Orientation = xlRowField
.Position = 2
End With
With PvtTbl.PivotFields("Budget Org")
.Orientation = xlRowField
.Position = 3
End With
With PvtTbl.PivotFields("Vendor Name")
.Orientation = xlRowField
.Position = 4
End With
With PvtTbl.PivotFields("Fiscal Year")
.Orientation = xlRowField
.Position = 5
End With
With PvtTbl.PivotFields("Fiscal Year")
.Orientation = xlColumnField
.Position = 1
End With
' Add data field if does not exist
On Error Resume Next
PvtTbl.AddDataField PvtTbl.PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum
Exit Function
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Exit Function
End Function