This code used to work on office 365. I am now working on office 2016 and I am getting a runtime error on the final line. The input to this is:
'Create a Pivot table called pt commission on sheet "Pivot Table" from the data on sheet2
Call ptSettings.CreatePivotTable("Pivot Table", Sheet2, "ptCommission")
The sub that is throwing the error on the final line is:
Sub CreatePivotTable(ptSheet As String, dSheet As Worksheet, ptName As String)
'Creates a pivottable called ptName on sheets(ptSheet) with the data from dsheet
Dim ptCache As PivotCache
Dim ptTable As pivotTable
Dim ptRange As Range
Dim lastRow As Long
Dim lastCol As Long
Application.DisplayAlerts = False
Worksheets(ptSheet).Delete
Sheets.Add before:=ActiveSheet
ActiveSheet.Name = ptSheet
Application.DisplayAlerts = True
lastRow = dSheet.Cells(Rows.Count, 2).End(xlUp).Row
lastCol = dSheet.Cells(2, Columns.Count).End(xlToLeft).Column
Set ptRange = dSheet.Cells(1, 1).Resize(lastRow, lastCol + 1)
Set ptCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=ptRange)
Set ptTable = ptCache.CreatePivotTable _
(TableDestination:=Sheets(ptSheet).Cells(3, 1), TableName:=ptName)
End Sub
Cheers for taking a look guys!
Just found out what was happening. There was data in the second row making the lastCol be higher than it needed to be. Then when I tried to create a pivot table from that range it threw the error because ptRange didnt have column headings.
I only realised after I tried running vs stepping through it and it came out with a different error.. Oh VBA.
Related
I am struggling to find a solution to the issue I am having; I've been looking all over. I'm not sure if it is how I am obtaining my first row or if it is something else. I have the exact same code (below) setup for another macro but that macro pulls R1C1:lastrow/lastcol. The only difference is: this macro attempts to use a dynamic first row (instead of Set PRange = glData.Cells(1, 1).Resize(LastRow, LastCol)) . I've even tried setting the first row as R10C1(the header row of the source data) and I still get an "Application-defined or object-defined error".
Macro use: Creates pivot table based on source data in range A(y):N(x); x = dynamic lastrow/col, y = dynamic first row. Destination is 4 columns to the right of another pivot table(created by a different sub). They will not overlap (unless something is hidden). I have made this setup manually and it works fine.
Any help is appreciated.
Sub CreateFAPiv()
'
Dim PSheet As Worksheet
Dim wsData As Worksheet: Set wsData = Sheets("Data")
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim asset As String
Dim glData As Worksheet: Set glData = Sheets("GL")
asset = glData.Range("B2").Value
Set PSheet = Worksheets("Piv")
'Define Data Range
FirstRow = IIf(IsEmpty(glData.Range("C1")), glData.Range("C1").End(xlDown).Row, 1)
LastRow = glData.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = glData.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = glData.Cells(FirstRow, 1).Resize(LastRow, LastCol)
'Define Pivot Cache - This is where I am getting the error
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(3, 4), _
TableName:="DataPivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(3, 4), TableName:="DataPivotTable")
.....Rest of code....
End Sub
I am trying to create a macro that will take data that starts at A18, find the last row and last column then generate a pivot table. I searched around to take bits and pieces from code I found online to try to make something work.
I keep getting a 1004 error, and I suspect it is because my code isn't actually selecting the data range properly.
this is the code that the error happens on:
Set pvtable = pvcache.CreatePivotTable(TableDestination:=pvsheet.Cells(1, 1), TableName:="Payroll")
this is all of the code:
Dim pvtable As PivotTable
Dim pvcache As PivotCache
Dim ptrange As Range
Dim pvsheet As Worksheet
Dim pdsheet As Worksheet
Dim plr As Long
Dim plc As Long
Dim startCell As Range
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("Pivot table").Delete 'to delete the existing pivot table in the worksheet
Worksheets.Add After:=ActiveSheet ' to add a new worksheet
ActiveSheet.Name = "Pivot Table" ' to rename the worksheet
On Error GoTo 0
Set pvsheet = Worksheets("Pivot table")
Set pdsheet = Worksheets("sheet1")
Set startCell = Range("A18")
'two variable to find Last used row and column in sheet 1, raw data'
plr = pdsheet.Cells(pdsheet.Rows.Count, startCell.Column).End(xlUp).Row
plc = pdsheet.Cells(startCell.Row, pdsheet.Columns.Count).End(xlToLeft).Column
'set range from selected data
Set ptrange = pdsheet.Cells(1, 1).Resize(plr, plc)
'pivot cahe needed for data load
Set pvcache = ActiveWorkbook.PivotCaches.Create(xlDatabase, SourceData:=ptrange)
'create empty pivot table
Set pvtable = pvcache.CreatePivotTable(TableDestination:=pvsheet.Cells(1, 1), TableName:="Payroll")
'Insert worker to Row Filed
With pvsheet.PivotTables("Payroll").PivotFields("Worker")
.Orientation = xlRowField
.Position = 1
End With
'Insert Street to Row Filed & position 2
With pvsheet.PivotTables("Payroll").PivotFields("Actual Hours")
.Orientation = xlRowField
.Position = 2
End With
'to show the pivot table in Tabular form
pvsheet.PivotTables("Payroll").RowAxisLayout xlTabularRow
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I am suspecting the issue is within this area here where the data range is selected to make the pivot table:
Set pvsheet = Worksheets("Pivot table")
Set pdsheet = Worksheets("sheet1")
Set startCell = Range("A18")
'two variable to find Last used row and column in sheet 1, raw data'
plr = pdsheet.Cells(pdsheet.Rows.Count, startCell.Column).End(xlUp).Row
plc = pdsheet.Cells(startCell.Row, pdsheet.Columns.Count).End(xlToLeft).Column
'set range from selected data
Set ptrange = pdsheet.Cells(1, 1).Resize(plr, plc)
any help appreciated, thank you
Try defining your range as follows...
Set ptrange = pdsheet.Range(startCell, pdsheet.Cells(plr, plc))
Or, alternatively...
Set pdsheet = Worksheets("sheet1")
Set startCell = pdsheet.Range("A18")
With pdsheet
plr = .Cells(.Rows.Count, startCell.Column).End(xlUp).Row
plc = .Cells(startCell.Row, .Columns.Count).End(xlToLeft).Column
Set ptrange = .Range(startCell, .Cells(plr, plc))
End With
I am trying to dynamically retrieve the range address of data then change the pivot table data source range address.
There are three sheets involved.
1) ThisWorkbook.Worksheets("sheet1") - main dashboard, has pivot chart and slicer that were moved from sheet2
2) ThisWorkbook.Worksheets("sheet2") - Pivot Table
3) ThisWorkbook.Worksheets("sheet3") - source data that was copied from different workbook before the below code runs.
My code gives
Run-time error 5: Invalid Procedure call or argument
The error points to Set pt = Pivot_sht.PivotTables(PivotName).ChangePivotCache(pc)
I have two other pivot charts on my main sheet. Using the same code they refresh without any issues.
Full code:
Option Explicit
Sub test()
Dim daMa As Worksheet
Dim daPerf As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim DataRange As Range
Dim PivotName As String
Dim NewRangePH As String
Dim pt As PivotTable
Dim pc As PivotCache
'REFRESHING PERFORMANCE HISTORY
'Set Variables Equal to Data Sheet and Pivot Sheet
Set Data_sht = ThisWorkbook.Worksheets("sheet3")
Set Pivot_sht = ThisWorkbook.Worksheets("sheet2")
'Enter in Pivot Table Name
PivotName = "PHPivot"
With Data_sht
.Activate
'Dynamically Retrieve Range Address of Data
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
LastCol = 12
Set DataRange = Data_sht.Range(Cells(LastRow, 1).Address, Cells(1, LastCol).Address)
End With
NewRangePH = Data_sht.Name & "!" & _
DataRange.Address(ReferenceStyle:=xlR1C1)
'Make sure every column in data set has a heading and is not blank (error prevention)
If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
MsgBox "One of your data columns has a blank heading." & vbNewLine _
& "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
Exit Sub
End If
'Change Pivot Table Data Source Range Address
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRangePH)
Set pt = Pivot_sht.PivotTables(PivotName).ChangePivotCache(pc)
End Sub
I searched through many Google result and results from Stack Overflow and tried at least 10 different things before posting this question.
"set pt = " is worng, you do not want to set a new pivottable.
Instead use
Pivot_sht.PivotTables(PivotName).ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
newRangePH, Version:=xlPivotTableVersion15)
I'm trying to create a pivot table and place it in a predefined location (not a new sheet).
Before running the macro each time, the pivot table is deleted and also the predefined sheet.
I noticed that when you create a table manually, the table name increases by one each time (PivotTable2, PivotTable3...), which I think is where my code is falling down.
I get a Run-time error 5, invalid procedure call or argument on this line:
ActiveWorkbook.PivotCaches.Create
I did check out this thread, which says that you can remove the table name parameter completely, or rename it - however I still get errors.
My code:
Sub CreatePivot()'
' CreatePivot Macro
'
' Set data as table
Sheets("Filtered Flags").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$16000"), , xlYes).Name _
= "Table1"
' Create worksheet for pivot output
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Flag Pivot"
'Create Pivot Table
Sheets("Filtered Flags").Select
Range("Table1[[#Headers],[Order '#]]").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Table1", Version:=6).CreatePivotTable TableDestination:="Flag Pivot!R3C1" _
, TableName:="PivotTable5", DefaultVersion:=6
Sheets("Flag Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable5").PivotFields("Material #")
.Orientation = xlRowField
.Position = 1
End With
End Sub
So there's a few things to work with here. One of the basics to get started with (and to understand why some of my example below is constructed) is to learn about avoiding the use of Select and Activate. Also, always using Option Explicit will help you sidestep many problems in naming and using variables.
Option Explicit
Public Sub CreatePivot()
'--- establish some basic objects to use...
Dim flagsWS As Worksheet
Set flagsWS = ThisWorkbook.Sheets("Filtered Flags")
'--- now, define the range of cells that contain the data
' and create the pivot cache
With flagsWS
Dim lastRow As Long
Dim lastCol As Long
Dim dataArea As Range
Dim dataAreaString As String
lastRow = .Cells(.Cells.rows.count, 1).End(xlUp).Row
lastCol = .Cells(1, .Cells.Columns.count).End(xlToLeft).Column
Set dataArea = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
dataAreaString = .Name & "!" & dataArea.Address
Dim pCache As PivotCache
Set pCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=dataAreaString)
End With
'--- create or clear the sheet for our new pivot
Dim pivotWS As Worksheet
On Error Resume Next
Set pivotWS = ThisWorkbook.Sheets("Flag Pivot")
On Error GoTo 0
If Not pivotWS Is Nothing Then
'--- delete everything on the worksheet so we're starting clean
pivotWS.Cells.Clear
Else
Set pivotWS = ThisWorkbook.Sheets.Add
pivotWS.Name = "Flag Pivot"
End If
'--- finally create the pivot table
Dim flagPT As PivotTable
Set flagPT = pivotWS.PivotTables.Add(PivotCache:=pCache, _
TableDestination:=pivotWS.Range("A4"), _
TableName:="AnnasPivotTable")
End Sub
Good mrng!
I am trying to create pivot table using vba and i am very new to pivot using vba and i tried to research in google as much as possible to get this corrected but didnt find much info which can help me to fix it, would be of great help if anyone can help me with this.
Range - always starts from A10, columns will be fixed until H but number of rows are not fixed hence i tried to define the range and use it in the code but its throwing me below error message, please check and correct me
Issues faced-Not able to define Rng as Range and not able to use this range in the pivot table.
Rng as Range
Run time error '91': Object variable or with black variance not set
Pivot cache
Run Time error '438': Object doesn't support this property or method
Data
ACT AN Currency CB LC Type CB FC Type SI
1001 c USD 2,031 Dr 2,031 Dr 0005
1002 a BHD 1,194 Dr 1,194 Dr 0105
1003 P EUR 326 Dr 326 Dr 0110
1004 AR GBP 60,467 Dr 60,467 Dr 0125
1005 AP DHS (73,080) Cr (73,080) Cr 0190
Sub Pivot()
Dim ws As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
'Dim Rng As Range
'Defining Range
Rng = Range("A10").Select
Rng = Range(Selection, Selection.End(xlToRight)).Select
Rng = Range(Selection, Selection.End(xlDown)).Select
'Adding new worksheet
Set ws = Worksheets.Add
'Creating Pivot cache
Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "Working!Rng").Select
'Creating Pivot table
Set pt = pc.CreatePivotTable(ws.Range("B3"))
'Setting Fields
With pt
'set row field
With .PivotFields("SI")
.Orientation = xlRowField
.Position = 1
End With
'set column field
With .PivotFields("Currency")
.Orientation = xlColumnField
.Position = 1
End With
End With
End Sub
Thanks for your help!
Regards
Suresh7860
Try and use the below code as a sample for what you need. If anything is unclear I will be happy to answer. But you won't learn if I write the code for you.
Sub BuildPT()
Dim pvtTbl As PivotTable
Dim pvtCha As PivotCache
Dim pvtDestWS As Worksheet
Dim pvtSrcWS As Worksheet
Dim pvtWB As Workbook
Dim pvtSrcRng As Range
Dim pvtStrt As Range
Dim keyRng As Range
Dim LastRow As Integer
Dim LastCol As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
pvtWB.Worksheets("Total").Delete 'Delete PT destination sheet
On Error GoTo 0
Set pvtSrcWS = pvtWB.Worksheets("Data") 'Set source sheet name
'Here I find the last row and column containing data
LastRow = pvtSrcWS.Cells.Find(What:="*", After:=pvtSrcWS.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, MatchByte:=False).row
LastCol = pvtSrcWS.Cells.Find(What:="*", After:=pvtSrcWS.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False, MatchByte:=False).Column
Set pvtSrcRng = Range(pvtSrcWS.Cells(1, 3), pvtSrcWS.Cells(LastRow, LastCol)) 'Set the range that contains the source data
Set pvtDestWS = pvtWB.Sheets.Add 'Add the destination sheet
pvtDestWS.Name = "Total" 'Rename destination sheet
Set pvtStrt = pvtDestWS.Cells(1, 1) 'Set the PT start location
'Here I create the pivot cache, the container that holds pivot table data
'Then I create the pivot table itself
Set pvtCha = pvtWB.PivotCaches.Create(xlDatabase, pvtSrcRng)
Set pvtTbl = pvtCha.CreatePivotTable(TableDestination:=pvtStrt, TableName:="Test PT")
'Now I add the fields I need
With pvtTbl
With .PivotFields("Amount")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
End With
With .PivotFields("Account")
.Orientation = xlPageField
.CurrentPage = "513035"
End With
.PivotFields("Key").Orientation = xlRowField
.RepeatAllLabels xlRepeatLabels
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub