I am trying to write a code to create a pivot table (as part of a much larger code) and I just can't get it to detect the source data. Unfortunately, each time the code will run the data will be of a different number of rows, so I want the code to automatically find the last cell with data in it.
I keep getting errors stating that an object is required or a variable is not defined. Despite going to the VBA error guide, I cant find what is wrong.
Can anyone see what the problem here is? Or even if there is a more efficient way to do it?
Sub CreatePivotTable()
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As Range, LRow As Range, LCol As Range
'Determine the data range you want to pivot
Set LRow = Cells(Rows.Count, 1).End(xlUp).Row
Set LCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set SrcData = Worksheets("Raw Data").Range("A1:Cells(LRow,LCol)")
'Create a new worksheet
Sheets.Add.Name = "Pivot Table"
'Where do you want Pivot Table to start?
StartPvt = Worksheets("Occupancy").Range("A15")
'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:="Occupancy")
'Create the headings and row and column orientation
pvt.PivotFields("Precinct").Orientation = xlPageField
pvt.PivotFields("Number").Orientation.xlDataField.Function = xlCount
pvt.PivotFields("Captured Date").Orientation.xlColumnField.Position = 1
pvt.PivotFields("Captured Session").Orientation.xlColumnField.Position = 2
pvt.PivotFields("Session Location").Orientation.xlRowField.Position = 1
'Turn on Automatic updates/calculations --like screenupdating to speed up code
pvt.ManualUpdate = False
End Sub
Anything within quotes is a string and hence "A1:Cells(LRow,LCol)" becomes a string and doesn't take the address of the cells(LRow,LCol)
Change
Set SrcData = Worksheets("Raw Data").Range("A1:Cells(LRow,LCol)")
to
LastCol = Split(Cells(, LCol).Address, "$")(1)
Set SrcData = Worksheets("Raw Data").Range("A1:" & LastCol & LRow)
or to this
Set SrcData = Worksheets("Raw Data").Range("A1:" & Cells(LRow,LCol).Address(False, False))
Also change
Dim LRow As Range, LCol As Range
Set LRow = Cells(Rows.Count, 1).End(xlUp).Row
Set LCol = Cells(1, Columns.Count).End(xlToLeft).Column
to
Dim LRow As Long, LCol As Long
LRow = Cells(Rows.Count, 1).End(xlUp).Row
LCol = Cells(1, Columns.Count).End(xlToLeft).Column
Use a table to store the data and give it a name. Then set the pivot source to the table name
Related
i have a hard time finding the solution for this error, i checked many posts but to no avail, it stays that there is a problem with this line
Set ptable = pCache.CreatePivotTable( _
TableDestination:=DestSheet.Cells(1, 1), _
TableName:="PivotTable1", _
DefaultVersion:=6)
so here is the code
Sub TestPivot()
Dim mySourceData As String
'Declare Variables
Dim SourceSheet As Worksheet
Dim DestSheet As Worksheet
'Declare Variales row and column
Dim FirstRow As Long
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim ptable As PivotTable
Dim pCache As PivotCache
'Set/Define Source and Destination Variables
With ThisWorkbook
Set SourceSheet = Worksheets("W")
Set DestSheet = Worksheets("Pivot_W")
End With
'identify first row and first column of source data cell range
FirstRow = 2
FirstCol = 2
'Find last row and last column of source data cell range
'And obtain address of source data cell range
With Sheets("W").Range("A:N")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
mySourceData = .Range(.Cells(FirstRow, FirstCol), .Cells(LastRow, LastCol)).Address(ReferenceStyle:=xlR1C1)
End With
'Insert Pivot Table
Set pCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SourceSheet.Name & "!" & mySourceData, Version:=6)
Set ptable = pCache.CreatePivotTable(TableDestination:=DestSheet.Cells(1, 1), TableName:="PivotTable1", DefaultVersion:=6)
If Not IsEmpty(ptable) Then
MsgBox "non vide"
End If
With DestSheet.PivotTables("PivotTable1").PivotFields("Magasin")
.Orientation = xlRowField
.Position = 1
End With
End Sub
I appreciate your help and thank you for reading my post.
My question is very similar to the following:
Excel VBA code to select non empty cells
However, I have some empty cells in between. In particular, I'm trying to define a range where the first row needs to be excluded, since it's a header. I also have to exclude the empty cells that follow. I was trying something like
Dim wb as workbook, ws as worksheet
Dim myrange as range
'Defined reference wb and ws
myrange=ws.range("B2",range("B2"),end(xldown))
But this only works if there are not empty cells in between. So, is there a fast and simple way to dynamically select a range that includes non-empty cells, excepted the header?
Try this
'Defined reference wb and ws
Set myrange = ws.range("B2", ws.Range("B" & Rows.Count).End(xlUp))
Don't forget to use the Set keyword
Try the next way, please:
Sub testDefineRange()
Dim ws As Worksheet, lastRow As Long, myrange As Range
Set ws = ActiveSheet 'use here what you need
lastRow = ws.Range("B" & ws.rows.count).End(xlUp).row
'Defined reference ws
Set myrange = ws.Range("B2:B" & lastRow)
myrange.Select
End Sub
I have found this link to be very useful on MANY occasions.
https://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
Ways To Find The Last Row
Sub FindingLastRow()
'PURPOSE: Different ways to find the last row number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ActiveSheet
'Using Find Function (Provided by Bob Ulmas)
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'Using SpecialCells Function
LastRow = sht.Cells.SpecialCells(xlCellTypeLastCell).Row
'Ctrl + Shift + End
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastRow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row
'Using Table Range
LastRow = sht.ListObjects("Table1").Range.Rows.Count
'Using Named Range
LastRow = sht.Range("MyNamedRange").Rows.Count
'Ctrl + Shift + Down (Range should be first cell in data set)
LastRow = sht.Range("A1").CurrentRegion.Rows.Count
End Sub
Ways To Find The Last Column
Sub FindingLastColumn()
'PURPOSE: Different ways to find the last column number of a range
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim LastColumn As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
'Ctrl + Shift + End
LastColumn = sht.Cells(7, sht.Columns.Count).End(xlToLeft).Column
'Using UsedRange
sht.UsedRange 'Refresh UsedRange
LastColumn = sht.UsedRange.Columns(sht.UsedRange.Columns.Count).Column
'Using Table Range
LastColumn = sht.ListObjects("Table1").Range.Columns.Count
'Using Named Range
LastColumn = sht.Range("MyNamedRange").Columns.Count
'Ctrl + Shift + Right (Range should be first cell in data set)
LastColumn = sht.Range("A1").CurrentRegion.Columns.Count
End Sub
If it suits your case, I like to use CurrentRegion with Intersect to eliminate the title row.
with ws.range("b2")
set myRange = intersect(.currentregion, .currentregion.offset(1,0))
end with
debug.print myRange.address
I keep having the same error "13" "type incompatibility" while doing a pivot table.
Sub tracer()
Dim cache As PivotCache
Dim table As PivotTable
Dim prange As range
Dim lastrow As Long
Dim lastcol As Long
lastrow = data.Cells(data.Rows.count, "A").End(xlUp).Row
lastcol = 15
Set prange = data.Cells(1, 1).Resize(lastrow, lastcol)
graphe_clos.Select
Set cache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=prange)
Set table = cache.CreatePivotTable(TableDestination:=graphe_clos.Cells(1, 1), TableName:="Terminator")
End Sub
Thank you for Help
The safer way to assign SourceData to your PivotCache is by using the following line
Set Cache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pRange.Address(False, False, xlA1, xlExternal))
adding the fourth parameter xlExternal verifies that the range is also pulling the worksheet's name.
See more explanation inside the code's comments.
Modified Code
Sub tracer()
Dim Cache As PivotCache
Dim Table As PivotTable
Dim pRange As Range
Dim LastRow As Long
Dim LastCol As Long
' use With statement to shorten and fully qualify all your nested objects
With Data
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = 15
' set the Range of the Pivot's data
Set pRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
' graphe_clos.Select '<-- you don't need to "Select" the sheet in order to create the Pivot-Table
End With
' set the Pivot Cache
Set Cache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pRange.Address(False, False, xlA1, xlExternal))
' set the Pivot Table
Set Table = Cache.CreatePivotTable(TableDestination:=graphe_clos.Cells(1, 1), TableName:="Terminator")
End Sub
Regarding your latest question, modify:
With ActiveSheet.PivotTables("Terminator").PivotFields("Evt F")
With
With Table.PivotFields("Evt F")
since you already set your PivotTable object to Table.
I am finding this issue "Run-time error '5' Invalid procedure call or argument" when defining the PivotCache on my code. The Excel I am using is 2016 MSO (16.0.4266.1001) 32 bit. VBA 7.
'Declare Variables
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
'Sort Age of Case
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range("M" & LastRow).Sort Key1:=Range("M3:M" & LastRow), _
Order1:=xlAscending, Header:=xlYes
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets.Add(After:=Worksheets(1)).Name = "US MASTER"
Application.DisplayAlerts = True
Set PSheet = Worksheets("US MASTER")
Set DSheet = Worksheets("US Master Macro")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
'
'Pivot Table 1
'
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Range("B3"), TableName:="Total Backlog")
When creating a PivotCache, MSDN recommends using a String reference to specify the workbook, worksheet and cell range for SourceData, instead of passing a Range object.
Instead of using PRange (which you've forgotten to Set here), you can use R1C1 notation, like this answer suggests.
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
... SourceData:="'US Master Macro'!R1C1:R" & LastRow & "C" & LastCol
Just in case anyone is encountering a similar problem and the above answer does not solve, if you are using Slicers which are connected to various pivots (all of which come from the same data source) then the ChangePivotCache will not work unless you disconnect the pivots from the slicer first.
A few days of searching through questions/answers and finally came across the problem!
I am trying to write a macro which will find a value "Spot price" in a header of a table2 and then take the whole column where that value is to copy and paste it (as values and not formulas). I need to do it because in that column I have a reference to external workbook and I need to share this worksheet without sharing the other workbook. This is what I wrote
Sub row()
Dim firstrow As Range
Dim ColumnToPaste As Range
Dim copy As Range
Set firstrow = Worksheets("Raw Data").ListObjects("Table2").HeaderRowRange
Set ColumnToPaste = firstrow.Find("Spot price", , xlValues, xlWhole).Columns(1)
With Worksheets("Raw Data").Range(ColumnToPaste)
.PasteSpecial Paste:=xlPasteValues
End With
End Sub
The error occurs on this line (Application-defined or object-defined error):
With Worksheets("Raw Data").Range(ColumnToPaste)
I think I'm using wrong range argument but not sure how to write it properly.
How about the following, instead of copying the full column, specify the range:
Sub row2()
Dim ws As Worksheet: Set ws = Sheets("Raw Data")
'declare and set your worksheet, amend as required
Dim firstrow As Range
Dim ColumnToPaste As Range
Dim LastRow As Long
Set firstrow = ws.ListObjects("Table2").HeaderRowRange
Set ColumnToPaste = firstrow.Find("Spot price", , xlValues, xlWhole).Columns
col = ColumnToPaste.Column
LastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
'get the last row with data on Column A
With ws
.Range(.Cells(1, col), .Cells(LastRow, col)).Copy
.Range(.Cells(1, col), .Cells(LastRow, col)).PasteSpecial xlPasteValues
End With
End Sub