With the help of below coding, I am able to create Pivot table. I am facing problem when I change the table destination to another sheet.
If I use below coding, it is working fine.
Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, Tabledestination:=Range("A1"))
If I use below coding, it is showing error as invalid procedure.
Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, Tabledestination:=ThisWorkbook.Sheets("Sheet4").Range("A1"))
Complete code.
Dim PT As PivotTable
Dim PTCache As PivotCache
Worksheets("Sheet3").Select
Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, Tabledestination:=ThisWorkbook.Sheets("Sheet4").Range("A1"))
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, Cells(1, 1).CurrentRegion)
With PT
.PivotFields("phase").Orientation = xlColumnField
.PivotFields("month").Orientation = xlColumnField
.PivotFields("vertical").Orientation = xlRowField
.PivotFields("pp").Orientation = xlDataField
.DisplayFieldCaptions = False
End With
Try with
Tabledestination:=ThisWorkbook.Sheets("Sheet4").Name & "!R1C1"
Use Row number and Column number referencing syntax.
This works for me:
Dim PT As PivotTable
Dim PTCache As PivotCache
Worksheets("Sheet3").Select
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, Cells(1, 1).CurrentRegion)
Set PT = PTCache.CreatePivotTable("Sheet4!R1C1", "PivotPP")
With PT
.PivotFields("phase").Orientation = xlColumnField
.PivotFields("month").Orientation = xlColumnField
.PivotFields("vertical").Orientation = xlRowField
.PivotFields("pp").Orientation = xlDataField
.DisplayFieldCaptions = False
End With
Related
I've been wanting to create a pivot table off of a sheet called "Data". I worked on the code at first and everything worked out, but for some reason I now get the following error:
Run-time error '440' Method 'Create" of object 'PivotCaches' failed
Here's my code:
Option Explicit
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Sub Create_Pivot_Table()
Dim LastRow As Long, LastColumn As Long
Dim DataRange As range
Dim PTCache As PivotCache
Dim PT As PivotTable
Set wb = ThisWorkbook
Set wsData = ThisWorkbook.Worksheets("Data")
Call Delete_PT_Sheet
With wsData
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
Set DataRange = .range(.Cells(1, 1), .Cells(LastRow, LastColumn))
Set wsPT = wb.Worksheets.Add
wsPT.Name = "Pivot Table"
Set PTCache = wb.PivotCaches.Create(xlDatabase, DataRange)
Set PT = PTCache.CreatePivotTable(wsPT.range("B5"), "PIVOT")
With PT
'// Pivot Table Layout Settings
.RowAxisLayout xlTabularRow
.ColumnGrand = False
.RowGrand = False
.HasAutoFormat = False
'//Row Section (Layer 1)
With .PivotFields("Helper")
.Orientation = xlRowField
.Position = 1
.LayoutBlankLine = False
End With
'// Values Section
With .PivotFields("Quantity")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##;(#,##);-"
End With
End With
End With
wsPT.Cells.EntireColumn.AutoFit
'//Releasing object memories
Set PTCache = Nothing
Set wsPT = Nothing
Set DataRange = Nothing
Set wsData = Nothing
Set wb = Nothing
End Sub
Private Sub Delete_PT_Sheet()
On Error Resume Next
Application.DisplayAlerts = False
wb.Worksheets("Pivot Table").Delete
End Sub
Could someone review the code and help me to fix it?
Thanks in Advance!
I am trying to copy Pivot table values into a new sheet using VBA. I am getting a runtime error 5. Here is my code
Sub test()
Dim shtTarget As Worksheet, pvtSht As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim field As PivotField
Dim rngSource As Range
Dim wb As Workbook: Set wb = ThisWorkbook
With wb
Set rngSource = .Sheets(2).Range("A5").CurrentRegion
Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.Count))
Set pc = .PivotCaches.Create(xlDatabase, rngSource.Address(False, False, xlA1, xlExternal))
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3", , xlPivotTableVersion14)
End With
With pt.PivotFields("Concatenate")
.Orientation = xlRowField
.Position = 1
End With
pt.AddDataField pt.PivotFields("SCREEN_ENTRY_VALUE"), "Sum of SCREEN_ENTRY_VALUE", xlSum
With wb
Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
pvtSht.Name = "Sum of Element Entries"
pt.TableRange2.Copy
pvtSht.Range("A1").PasteSpecial xlPasteValues
End With
End Sub
My pivot table is in a range of A5:I266. The code errors out on Set pt = pc.CreatePivotTable...
Replace:
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3", , xlPivotTableVersion14)
with:
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3")
My code runs perfect... but somehow it adds a data field every time it runs. I tried to test it if it exists with If pf.Orientation = xlDataField = True Then...("Don't add xlDataField")... Still no results.
I am pretty sure I am missing something important here otherwise the code runs good. Is there a way not to add another field if it already exists?.
Sub Import()
Dim ws As Worksheet, pvtCache As PivotCache
Dim wsp As Worksheet
Dim pf As PivotField, pt As PivotTable
Set wsp = Sheets("Pivot")
Set pt = wsp.PivotTables("PivotTable")
ActiveWorkbook.RefreshAll
Sheets("TP_Coois").Cells.Replace ",", "", xlPart
Set pf = pt.PivotFields("Sales")
If pf.Orientation = xlDataField = True Then '***I believe here is something wrong***
pt.PivotCache.Refresh
Else
With pf
.Orientation = xlDataField
.Function = xlSum
End With
pt.PivotCache.Refresh
End If
End Sub
Any Help is appreciated
Try changing your conditional from:
If pf.Orientation = xlDataField = True Then
To this:
If pf.Orientation = xlDataField Then
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
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