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")
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 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 newbie in vba and am trying to create a PivotTable using VBA with excel.
I would like to creat like as below image as input sheet.
I am trying to add row labels of region, month, number, status and values are value1, value2 and total here I am able to set range for pivot, while executing it creates "pivottable" sheet only. not generate any pivot table for sheet1.
My Code:
Option Explicit
Public Sub Input_File__1()
ThisWorkbook.Sheets(1).TextBox1.Text = Application.GetOpenFilename()
End Sub
'======================================================================
Public Sub Output_File_1()
Dim get_fldr, item As String
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.AllowMultiSelect = False
If .Show <> -1 Then GoTo nextcode:
item = .SelectedItems(1)
If Right(item, 1) <> "\" Then
item = item & "\"
End If
End With
nextcode:
get_fldr = item
Set fldr = Nothing
ThisWorkbook.Worksheets(1).TextBox2.Text = get_fldr
End Sub
'======================================================================
Public Sub Process_start()
Dim Raw_Data_1, Output As String
Dim Raw_data, Start_Time As String
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
Start_Time = Time()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Raw_Data_1 = ThisWorkbook.Sheets(1).TextBox1.Text
Output = ThisWorkbook.Sheets(1).TextBox2.Text
Workbooks.Open Raw_Data_1: Set Raw_data = ActiveWorkbook
Raw_data.Sheets("Sheet1").Activate
On Error Resume Next
'Worksheets("Sheet1").Delete
Sheets.Add before:=ActiveSheet
ActiveSheet.Name = "Pivottable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Pivottable")
Set DSheet = Worksheets("Sheet1")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).coloumn
Set PRange = DSheet.Range("A1").CurrentRegion
Set PCache = ActiveWorkbook.PivotCaches.Create_(SourceType:=xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")
With PTable.PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
This needs some tidying up but should get you started.
Note the use of Option Explicit so variables have to be declared.
Columns names are as per your supplied workbook.
Option Explicit
Sub test()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim PRange As Range
Dim PCache As PivotCache
Dim PTable As PivotTable
Sheets.Add
ActiveSheet.Name = "Pivottable"
Set PSheet = Worksheets("Pivottable")
Set DSheet = Worksheets("Sheet1")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Range("A1").CurrentRegion
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")
With PTable.PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
With PTable.PivotFields("Channel")
.Orientation = xlRowField
.Position = 2
End With
With PTable.PivotFields("AW code")
.Orientation = xlRowField
.Position = 3
End With
PTable.AddDataField PSheet.PivotTables _
("PRIMEPivotTable").PivotFields("Bk"), "Sum of Bk", xlSum
PTable.AddDataField PSheet.PivotTables _
("PRIMEPivotTable").PivotFields("DY"), "Sum of DY", xlSum
PTable.AddDataField PSheet.PivotTables _
("PRIMEPivotTable").PivotFields("TOTal"), "Sum of TOTal", xlSum
End Sub
The code in my answer below is a little long, but it should deliver you the result you are seeking for.
First, to be on the safe side, first check if "Pivottable" sheet already exists in Raw_data workbook object (no need to create it again).
Second, the code is divided in the middle to 2 sections:
If the MACRO was ran before (this is the 2+ times you are running it), then "PRIMEPivotTable" Pivot-Table is already created, and there’s no need to create it again, or to set-up the Pivot-Table’s fields.
All you need to do is refresh the PivotTable with the updated PivotCache (with updated Pivot-Cache’s source range).
If this is the first time running this MACRO, then you need to set-up the PivotTable and all necessary PivotFields.
Detaile explanation of every step inide the code's comments.
Code
Option Explicit
Sub AutoPivot()
Dim Raw_data As Workbook
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PTable As PivotTable
Dim PCache As PivotCache
Dim PRange As Range
Dim LastRow As Long, LastCol As Long
Dim Raw_Data_1 As String, Output As String, Start_Time As String
Start_Time = Time()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Raw_Data_1 = ThisWorkbook.Sheets(1).TextBox1.Text
Output = ThisWorkbook.Sheets(1).TextBox2.Text
' set the WorkBook object
Set Raw_data = Workbooks.Open(Raw_Data_1)
Set DSheet = Raw_data.Worksheets("Sheet1")
' first check if "Pivottable" sheet exits (from previous MACRO runs)
On Error Resume Next
Set PSheet = Raw_data.Sheets("Pivottable")
On Error GoTo 0
If PSheet Is Nothing Then '
Set PSheet = Raw_data.Sheets.Add(before:=Raw_data.ActiveSheet) ' create a new worksheet and assign the worksheet object
PSheet.Name = "Pivottable"
Else ' "Pivottable" already exists
' do nothing , or something else you might want
End If
With DSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
' set the Pivot-Cache Source Range with the values found for LastRow and LastCol
Set PRange = .Range("A1", .Cells(LastRow, LastCol))
End With
' set a new/updated Pivot Cache object
Set PCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address(True, True, xlA1, xlExternal))
' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PTable = PSheet.PivotTables("PRIMEPivotTable") ' check if "PRIMEPivotTable" Pivot-Table already created (in past runs of this Macro)
On Error GoTo 0
If PTable Is Nothing Then ' Pivot-Table still doesn't exist, need to create it
' create a new Pivot-Table in "Pivottable" sheet
Set PTable = PSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=PSheet.Range("A1"), TableName:="PRIMEPivotTable")
With PTable
' add the row fields
With .PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("month")
.Orientation = xlRowField
.Position = 2
End With
With .PivotFields("number")
.Orientation = xlRowField
.Position = 3
End With
With .PivotFields("Status")
.Orientation = xlRowField
.Position = 4
End With
' add the 3 value fields (as Sum of..)
.AddDataField .PivotFields("value1"), "Sum of value1", xlSum
.AddDataField .PivotFields("value2"), "Sum of value2", xlSum
.AddDataField .PivotFields("TOTal"), "Sum of TOTal", xlSum
End With
Else ' Pivot-Table "PRIMEPivotTable" already exists >> just update the Pivot-Table with updated Pivot-Cache (update Source Range)
' just refresh the Pivot cache with the updated Range
PTable.ChangePivotCache PCache
PTable.RefreshTable
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
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
I am trying to loop though each worksheet in my workbook and reset all pivot data ranges to range("D1_Data") before refreshing.
Currently getting a Runtime error '1004' with the below code and somewhat stuck, any ideas?
Note that "TemplateWB" has been pre-set else where in my code as a workbook which the code is currently operating in.
'Set Dim
Dim PT As PivotTable
Dim WS As Worksheet
'Set D1_Data
TemplateWB.Sheets("Data_1").Range(Cells(1, 1), Cells(NewLastRow, NewLastColumn + 4)).Name = "D1_Data"
For Each WS In TemplateWB.Worksheets
For Each PT In WS.PivotTables
With PT.PivotCache
.SourceData = Range("D1_Data").Address(True, True, xlR1C1, True)
.Refresh
End With
Next PT
Next WS
Try the code below (I tested it on multiple Pivot Tables across different worksheets and it worked).
Option Explicit
Sub AutoRefreshPivot()
Dim WS As Worksheet
Dim PT As PivotTable
Dim PTCache As PivotCache
Dim NewLastRow As Long, NewLastColumn As Long
Dim TemplateWB As Workbook
' values for my internal testing
'Set TemplateWB = ThisWorkbook
'NewLastRow = 11
'NewLastColumn = 4
'Set D1_Data
TemplateWB.Sheets("Data_1").Range(Cells(1, 1), Cells(NewLastRow, NewLastColumn + 4)).Name = "D1_Data"
For Each WS In TemplateWB.Worksheets
For Each PT In WS.PivotTables
' set Pivot Cache to updated data source range (per each Pivot Table)
Set PTCache = TemplateWB.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Range("D1_Data").Address(True, True, xlR1C1, True), _
Version:=xlPivotTableVersion14)
With PT
.ChangePivotCache PTCache
' .Refresh
End With
' need to clear the cache every time after being used for a Pivot table
Set PTCache = Nothing
Next PT
Next WS
End Sub