I searched the internet code and was able to put together a macro to create a pivot table through VBA. I keep getting a Run time error '5': Invalid procedure call or argument when it gets to the creating the Pivot Table cache.
Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=mySourceWorksheet.Name & "!" & mySourceData).CreatePivotTable(TableDestination:=myDestinationWorksheet.Name & "!" & myDestinationRange, TableName:="TBPvt")
I have this same code create another pivot table and it works fine. I put both sets of code side by side and the only updates between the code is myDestinationWorksheet and the TableName in the code above. So I'm not sure what I did wrong.
Sub CreateTBpvt()
'declare variables to hold row and column numbers that define source data cell range
Dim myLastRow, myLastColumn As Long
Dim StartHere As String
StartHere = Sheets("Start Here").Range("C3").Value
'declare variables to hold source and destination cell range address
Dim mySourceData As String
Dim myDestinationRange As String
'declare object variables to hold references to source and destination worksheets, and new Pivot Table
Dim mySourceWorksheet As Worksheet
Dim myDestinationWorksheet As Worksheet
Dim myPivotTable As PivotTable
'identify source and destination worksheets
With ThisWorkbook
Set mySourceWorksheet = .Worksheets("TrialBalance")
Set myDestinationWorksheet = .Worksheets("TB Pivot")
End With
'obtain address of destination cell range
myDestinationRange = myDestinationWorksheet.Range("A1").Address(ReferenceStyle:=xlR1C1)
With mySourceWorksheet.Cells
'find last row and last column of source data cell range
myLastRow = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
myLastColumn = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'obtain address of source data cell range
mySourceData = .Range(.Cells(2, "A"), .Cells(myLastRow, myLastColumn)).Address(ReferenceStyle:=xlR1C1)
End With
'create Pivot Table cache and create Pivot Table report based on that cache
Set myPivotTable = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=mySourceWorksheet.Name & "!" & mySourceData).CreatePivotTable(TableDestination:=myDestinationWorksheet.Name & "!" & myDestinationRange, TableName:="TBPvt")
'add, organize and format Pivot Table fields
With myPivotTable
.PivotFields("Account").Orientation = xlPageField
.PivotFields("Descr").Orientation = xlRowField
With .PivotFields(StartHere)
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0.00"
End With
End With
End Sub
The destination sheet has a space in its name, so you need to surround it with single quotes:
TableDestination:="'" & myDestinationWorksheet.Name & "'!" & myDestinationRange
Related
This is my sample data.
And this is the VBA code produced with macro.
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1:C3").Select
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$C$3"), , xlYes).Name = _
"Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium9"
End Sub
How do I get the macro code?
Developer > Record Macro
Select all (ctrl + A) inside any cells within A1:C3
Home > Format as Table
Output
The problem is my data is dynamic and not necessarily stay at A1:C3.
It could be bigger or smaller.
E.g., let say I've bigger within range A1:C4 in different Ms Excel file.
The code above won't select all, instead it selects only A1:C3.
Last row A4:C4 won't be affected with this code.
How do I change this doesn't matter how big the table is?
Solution 1
You can use Range("A1").CurrentRegion to get the area of continous data (which is the same as Ctrl + A):
Option Explicit
Public Sub SelectCurrentRegion()
Dim MyData As Range
Set MyData = Worksheets("Sheet1").Range("A1").CurrentRegion
'don't use .select this is just for illustrating
MyData.Select
End Sub
Note that the number in cell D6 is not vertically nor horizontally connected with the other data. Therefore it is not selected by Ctrl + A or .CurrentRegion.
Solution 2
Or Worksheets("Sheet1").UsedRange to get the area of all data:
Option Explicit
Public Sub SelectCurrentRegion()
Dim MyData As Range
Set MyData = Worksheets("Sheet1").UsedRange
'don't use .select this is just for illustrating
MyData.Select
End Sub
You might benefit from reading
How to avoid using Select in Excel VBA.
#Pᴇʜ has already given you 2 solutions. Here is Solution 3. I would prefer finding last row and column over UsedRange and then construct the range. I have explained here why I do not prefer using UsedRange
Solution 3
Find the last row and last column and then create your range
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim rng As Range
'~~> Change this to relevant sheet
Set ws = Sheet1
With ws
LastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
LastColumn = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Set rng = .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
Debug.Print rng.Address
End With
End Sub
If you are using Excel tables then you can use DataBodyRange or Range Properties to select what you need to select.
Dim lstObj As ListObject
For Each lstObj In ActiveSheet.ListObjects
lstObj.DataBodyRange.Select ' Will select only data without headers
lstObj.Range.Select ' Will select complete table
Next lstObj
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
I am into a situation where I need to copy a range from a excel sheet and paste it to another. I have done the following coding which is going well...
Dim mpn As String
mpn = Application.InputBox(prompt:="Input the MPN column name:")
mpn1 = mpn
mpn2 = mpn1 & ":" & mpn
Set currentSheet = wbSource.Worksheets(1)
lastRow1 = currentSheet.Range(mpn1).End(xlDown).Row
ThisWorkbook.Sheets("Sheet2").Range("F2:F" & lastRow1) = currentSheet.Range(mpn2 & lastRow1).Value
This coding goes perfectly well untill there is any blank cell in the column. Can anyone please help me on this particular situation.
Like I mentioned in the comments above, instead of prompting for the column name, use .Find to locate the column name. What if user types Blah Blah in the input box?
Also as mentioned in comments use xlUp rather than xlDown to find the last row to counter for blank cells and other issues you may face. See this
Is this what you are trying? (Untested)
I have commented the code so you should not having a problem understanding it. But if you do then simply post back :)
Sub Sample()
Dim mpnCol As Long
Dim ColName As String, strSearch As String
Dim aCell As Range
Dim wbSource As Workbook
Dim wbInput As Worksheet, currentSheet As Worksheet
'~~> Change this to the Mpn Header
strSearch = "MPN"
'~~> This you have declared in your code
'~~> Change as applicable
Set wbSource = "Someworkbook"
Set currentSheet = wbSource.Worksheets(1)
Set wbInput = ThisWorkbook.Sheets("Sheet2")
With currentSheet
'~~> Search for the mpn header in row 1. Change as applicable
Set aCell = .Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'~~> Column Number
mpnCol = aCell.Column
'~~> Converting column number to column name
ColName = Split(.Cells(, mpnCol).Address, "$")(1)
'~~> Getting last row
lRow = .Range(ColName & .Rows.Count).End(xlUp).Row
'~~> Checking for excel versions. Comment this if the copying
'~~> will always happen in xl2007+ versions
If lRow > 65536 Then
MsgBox "Are you trying to copy from xl2007 to xl2003?. The number of rows exceed the row limit"
Exit Sub
End If
wbInput.Range("F2:F" & lRow).Value = .Range(ColName & "2:" & ColName & lRow).Value
Else
MsgBox strSearch & " header not found"
End If
End With
End Sub
To copy an entire column, reference your range with the .Columns() function.
You could use something like:
ThisWorkbook.Sheets("Sheet2").Columns("F") =
currentSheet.Columns(mpn1).Value
Another alternative would be to use the .Copy sub and specify a Destination for the copy:
currentSheet.Columns(mpn1).Copy
Destination:=ThisWorkbook.Sheets("Sheet2").Columns("F")
Application.CutCopyMode = false
This answer assumes both workbooks are saved with the same version of Excel. If one workbook is pre-2007, and one is 2007+, then the max number of rows allowed in a sheet will be different.
In that case, copying the entire column is not an option - check out Siddarth's answer for a longer solution to that extra complication. He checks for different number of rows to prevent the error.
Usually I avoid using merged cells but we got sheets from management software having something like this:
I found the easiest process is to un-merge, sort, then merge again but with a header to the table and the sheet number of sheets it became tedious. The fused cells are known (I+J, M+N) and table starts at row 11 so the page is set.
I tweaked a code which does the unmerge then merge part but need to make it sort, and is there a cleaner code than this
Sub Merge_fused()
'~~> unmerged range
Dim MyRange As Range
Set MyRange = Range("H11:X56")
'~~> merged columns
Dim IRange As Range
Set IRange = Range("I11:J56")
Dim MRange As Range
Set MRange = Range("M11:N56")
Dim VRange As Range
Set VRange = Range("V11:W56")
On Error Resume Next
With MyRange
.UnMerge
End With
'~~> i need to sort MyRange here
With IRange
.Merge True
End With
With MRange
.Merge True
End With
With VRange
.Merge True
End With
End Sub
I know this is a bit older but I just came across this and made the code work for me.
I add this code where it says '~~> i need to sort here the MyRange here
projp.Range("your range").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
Works perfectly for me
I'd do an automatic unmerge, and then just throw away the empty cells that pop up. So: no re-merging afterwards. This way you can afterwards sort your data anyway and anytime you want. The following code does just that (it also inserts blank cells at the end of the data table in case anything is following the table to the right).
' Unmerges the given column over the given rows
Sub UnmergeDataColumn( _
theSheet As Worksheet, _
firstCell As Range, lastCell As Range, _
columnNrAfterTable As Long, _
startMergedColumn As String, endMergedColumn As String _
)
' Unmerge the merged columns
Dim mergedColumns As Range
Set mergedColumns = theSheet.Range( _
startMergedColumn & firstCell.Row, _
endMergedColumn & lastCell.Row _
)
Call mergedColumns.UnMerge
' Throw away all unneeded cells
Dim emptyColumn As Range
Set emptyColumn = theSheet.Range( _
endMergedColumn & firstCell.Row, _
endMergedColumn & lastCell.Row _
)
Call emptyColumn.Delete(xlShiftToLeft)
' And insert extra padding after the table
Dim trailingColumn As Range
Set trailingColumn = theSheet.Range( _
theSheet.Cells(firstCell.Row, columnNrAfterTable), _
theSheet.Cells(lastCell.Row, columnNrAfterTable) _
)
Call trailingColumn.Insert(xlShiftToRight)
End Sub
Sub UnmergeData()
' Get the sheet
Dim theSheet As Worksheet
Set theSheet = Worksheets("Sheet1")
' Get the range of our table
Dim firstCell As Range
Set firstCell = theSheet.Range("K11")
Dim lastCell As Range
Set lastCell = theSheet.Range("X11").End(xlDown)
Dim columnNrAfterTable As Long
columnNrAfterTable = lastCell.Offset(0, 1).Column
' And unmerge the columns
Call UnmergeDataColumn( _
theSheet, _
firstCell, lastCell, _
columnNrAfterTable, _
"V", "W" _
)
Call UnmergeDataColumn( _
theSheet, _
firstCell, lastCell, _
columnNrAfterTable, _
"M", "N" _
)
Call UnmergeDataColumn( _
theSheet, _
firstCell, lastCell, _
columnNrAfterTable, _
"I", "J" _
)
End Sub