I have created a Macro for making a Pivot Table in Sheet "Pivot" from Data Sheet "Sheet1".
Although I am able to run the macro in my system but in other systems, it gives a Runtime Error 5 at ActiveWorkbook.PivotCaches.Create line.
Sub Make_Pivot()
'
' Make_Pivot Macro
Sheets("Sheet1").Select
Columns("D:G").Select
Range("G1").Activate
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C4:R1048576C7", Version:=6).CreatePivotTable TableDestination:= _
"Pivot!R1C1", TableName:="PivotTable1", DefaultVersion:=6
Sheets("Pivot").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("NDL")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Tracking IDs"), "Count of Tracking IDs", xlCount
Columns("A:B").Select
Range("B1").Activate
Selection.Copy
Range("G13").Select
Sheets("Count").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F18").Select
End Sub
Try the dynamic code below (explanations inside the code as comments):
Option Explicit
Sub Make_Pivot()
' Make_Pivot Macro
Dim WB As Workbook
Dim ws As Worksheet
Dim PvtSht As Worksheet
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Dim SrcData As Range
Dim LastRow As Long
' set the workbook object
Set WB = ThisWorkbook
' set the worksheet object where the Pivot-Table will be
Set PvtSht = ThisWorkbook.Worksheets("Pivot")
' set the worksheet object where the Data lies
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row ' <-- last row in column "G"
' set the Pivot-Cache SourceData object
Set SrcData = .Range("D1:G" & LastRow)
End With
' Create the Pivot Cache
Set PvtCache = WB.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=SrcData.Address(False, False, xlA1, xlExternal))
' === FOR DEBUG ONLY ===
MsgBox PvtCache.SourceData
' Set the Pivot Table Object (already created in previous macro run)
On Error Resume Next
Set PvtTbl = PvtSht.PivotTables("PivotTable1")
On Error GoTo 0
If PvtTbl Is Nothing Then ' <-- pivot table still doesn't exist >> need to create it
' create a new Pivot Table in "Pivot" sheet, start from Cell A1
Set PvtTbl = PvtSht.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=PvtSht.Range("A1"), TableName:="PivotTable1")
With PvtTbl
With .PivotFields("NDL")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Tracking IDs"), "Count of Tracking IDs", xlCount
End With
Else
' just refresh the Pivot table, with updated Pivot Cache
PvtTbl.ChangePivotCache PvtCache
PvtTbl.RefreshTable
End If
' rest of your code goes here ...
End Sub
Note: There's no need to use so many Select and Selection, instead use fully qualifed Range, Worksheet and Objects.
Related
I've been extensively looking into creating a pivot table through vba, and am facing some complications I can't find a solution to. I am trying to create a pivot table in column 4 of the sheet "Pivot". When I try to run my code I get:
"Run time Error 1004: PivotTableWizard method of Worksheet class failed."
Can anyone help? I am still very new to vba.
Here is my code, I keep getting error on the second line:
Sub PivotTable()
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=Sheets("Information").UsedRange).CreatePivotTable TableDestination:="Pivot!R1C4", TableName:="PivotTable", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(1, 1)
With ActiveSheet.PivotTables("PivotTable").PivotFields("PN")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("Commit")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables("PivotTable").PivotFields("Qty"), "Sum", xlSum
End Sub
You are looking for something like the code below (explanation inside the code comments) :
Option Explicit
Sub AutoPivotTable()
Dim Sht As Worksheet
Dim PvtSht As Worksheet
Dim SrcData As Range
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
'-- Determine the data range you want to pivot --
' Set the Worksheet object
Set Sht = ThisWorkbook.Worksheets("Information")
Set SrcData = Sht.UsedRange '1:Z10000").Address(False, False, xlR1C1, xlExternal)
' Set the Pivot Cache from Source Data
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData.Address(False, False, xlA1, xlExternal))
' Set the Worksheet object where the Pivot Table will be loated
Set PvtSht = ThisWorkbook.Worksheets("Pivot")
On Error Resume Next
'Set the pivot table object
Set PvtTbl = PvtSht.PivotTables("PivotTable") ' check if "PivotTable" Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If PvtTbl Is Nothing Then '<-- Pivot Table not created >> create it
' create a new Pivot Table in "Pivot" sheet
Set PvtTbl = PvtSht.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=PvtSht.Range("D1"), TableName:="PivotTable")
With PvtTbl
With .PivotFields("PN")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Commit")
.Orientation = xlColumnField
.Position = 1
End With
.AddDataField .PivotFields("Qty"), "Sum of Qty", xlSum
End With
Else ' just refresh the Pivot cache with the updated Range
PvtTbl.ChangePivotCache PvtCache
PvtTbl.RefreshTable
End If
End Sub
I recorded a macro that generated a very simple pivot table. When I played the macro back I get an error in the PivotTable.
I get:
Invalid procedure call or argument
So I went back and put single quotes around the SourceData and TableDestination. Now I get a pivot table but only with the total. It should give me the count of all the occurrences of the items in Column A.
Here's the code
Sub testpivot()
'
' testpivot Macro
'
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"'GF Response Detail R'!R1C1:R65536C1", Version:= _
xlPivotTableVersion10).CreatePivotTable TableDestination:= _
"'GF Response Detail R'!R2C10", TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
Sheets("GF Response Detail R").Select
Cells(2, 7).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Region"), "Count of Region", xlCount
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub
You want to remove the Pivot Table from the worksheet. Before you run the macro.
The code below will check first if there's a "PivotTable1" in the sheet, and if it does it will delete it.
Afterwards, it will create a new PivotTable on "GF Response Detail R" sheet, with the updated data in Column "A".
Code
Option Explicit
Sub testpivot()
' testpivot Macro
Dim PivTbl As PivotTable
Dim PivCache As PivotCache
Dim DataSht As Worksheet
Dim lastRow As Long
Dim SrcRng As Range
Dim SrcData As String
' set the Pivot Data
Set DataSht = Worksheets("GF Response Detail R")
With DataSht
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row '<-- get last row in Column A
Set SrcRng = .Range("A1:A" & lastRow) '<-- set dynamic Pivot Range
SrcData = SrcRng.Address(True, True, xlA1, xlExternal) '<-- get the Range Address, including sheet's name
End With
'-- first check if there's a "PivotTable1" in sheet >> if Yes, Delete it
For Each PivTbl In DataSht.PivotTables
If PivTbl.Name = "PivotTable1" Then
DataSht.Range(PivTbl.TableRange2.Address).Delete Shift:=xlUp
Exit For
End If
Next PivTbl
' set the Pivot Cache
'Set PivCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData)
' Option 2: set the Pivot Cache
Set PivCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcRng)
' Option 3: set the Pivot Cache
Set PivCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData, Version:=xlPivotTableVersion15)
' create a new Pivot Table in "EXP Pivot" sheet, start from Cell A1
Set PivTbl = DataSht.PivotTables.Add(PivotCache:=PivCache, TableDestination:=DataSht.Range("J2"), TableName:="PivotTable1")
With PivTbl
With .PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields("Region"), "Count of Region", xlCount
ActiveWorkbook.ShowPivotTableFieldList = False
End With
End Sub
Here try this. It is a slight variation of what #Shai Rado was suggesting.
Sub RegionMacro()
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
'define the sheet, last row, and pivot table range
Set DSheet = Worksheets("GF Response Detail R")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set PRange = DSheet.Range("A1:A" & LastRow)
'get address of range
sData = PRange.Address(False, True)
'check to see if the table already exist and delete it if it does
For Each PTable In DSheet.PivotTables
If PTable.Name = "RegionCountTable" Then
DSheet.Range(PTable.TableRange2.Address).Delete Shift:=xlUp
Exit For
End If
Next PTable
'define the pivot cache
Set PCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
'insert a blank pivot table into cell G2 and call it "RegionCountTable"
Set PTable = PCache.CreatePivotTable(TableDestination:=DSheet.Cells(2, 7), TableName:="RegionCountTable")
'insert row fields
With PTable
With ActiveSheet.PivotTables("RegionCountTable").PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
'create a count for the region
.AddDataField .PivotFields("Region"), "Count of Region", xlCount
ActiveWorkbook.ShowPivotTableFieldList = False
End With
End Sub
I created this code with macro recorder to get Pivot table automatically.
But when I run this code again an error message appears:
Run-time error 1004: Invalid reference
at this line Workbooks("works.xlsm").Connections.Add2.
Why is there invalid reference if this code was recorded? During the recording, I gave the name "database" for the table (R1C4:R18532C9). I use Windows 10 and Office 2016.
Range("D1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="database", RefersToR1C1:= _
"=Data!R1C4:R18532C9"
ActiveWorkbook.Names("database").Comment = ""
Range("D1").Select
Workbooks("works.xlsm").Connections.Add2 _
"WorksheetConnection_works.xlsm!database", "", _
"WORKSHEET;C:\Users\gabor\Documents\CAFM\VBS\works.xlsm", _
"works.xlsm!database", 7, True, False
ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
ActiveWorkbook.Connections("WorksheetConnection_works.xlsm!database"), _
Version:=6).CreatePivotTable TableDestination:="Pivot!R1C1", TableName:= _
"Statement1", DefaultVersion:=6
Sheets("Pivot").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("Statement1").CubeFields("[database].[Person]")
.Orientation = xlRowField
.Position = 1
End With
The database table and the pivot results with xlCount and xlDistinctCount
Try edited code below, explanations are inside the code as comments.
xlDistinctCount is untested as I have Office 2010 (it's available from Officde 2013), but should work.
Code
Option Explicit
Sub AutoDynamicPivot()
Dim PT As PivotTable
Dim PTCache As PivotCache
Dim WB As Workbook
Dim Sht As Worksheet
Dim SrcData As Variant
Dim lRow As Long, lCol As Long
Set WB = ThisWorkbook
Set Sht = WB.Worksheets("Data") '<-- set the "Data" worksheet
lRow = Sht.Range("A1").End(xlDown).Row '<-- modifed from "D1" to "A1" (according to PO screen-shot)
lCol = Sht.Range("A1").End(xlToRight).Column '<-- modifed from "D1" to "A1" (according to PO screen-shot)
' set the Named Range "database" to the data in worksheet "Data"
WB.Names.Add Name:="database", RefersToR1C1:="=" & Sht.Name & "!R1C1:R" & lRow & "C" & lCol '<-- modifed to "R1C1" (according to PO screen-shot)
WB.Names("database").Comment = ""
' Determine the data range you want for your Pivot Cache
Set SrcData = Range("database")
' set the Pivot Cache
Set PTCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, SrcData)
' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PT = Worksheets("Pivot").PivotTables("Statement1") ' check if "Statement1" Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If PT Is Nothing Then
' create a new Pivot Table in "Pivot" sheet, start from Cell A1
Set PT = Worksheets("Pivot").PivotTables.Add(PivotCache:=PTCache, TableDestination:=Worksheets("Pivot").Range("A1"), TableName:="Statement1")
'Create the headings and row and column orientation and all of your other settings here
With PT
' set "Person" as rows field
With .PivotFields("Person")
.Orientation = xlRowField
.Position = 1
End With
' set "Month" as Filter
With .PivotFields("Month")
.Orientation = xlPageField
.Position = 1
End With
' set "Count of Cases"
.AddDataField .PivotFields("Case"), "Count of Case", xlCount
' set "Distinct Count of Cases"
.AddDataField .PivotFields("Case"), "Distinct Count of Case", xlDistinctCount
End With
Else
' just refresh the Pivot cache with the updated Range (data in "Data" worksheet)
PT.ChangePivotCache PTCache
PT.RefreshTable
End If
End Sub
Screen-shot of the Pivot-Table created with this code:
I changed the commandtext parameter in Connections.Add2 from "works.xlsm!database" to "Data!database". It solved the problem. I edited the ActiveWorkbook.Names.Add as well.
LastRow = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
LastCol = Sheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
ActiveWorkbook.Names.Add _
Name:="database", _
RefersTo:="=Data!R1C4:R" & LastRow & "C" & LastCol & ""
ActiveWorkbook.Connections.Add2 _
"WorksheetConnection_works.xlsm!database", "", _
"WORKSHEET;C:\Users\gabor\Documents\CAFM\VBS\works.xlsm", _
"Data!database", 7, True, False
ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
ActiveWorkbook.Connections("WorksheetConnection_works.xlsm!database"), _
Version:=6).CreatePivotTable TableDestination:="Pivot!R1C1", TableName:= _
"Statement1", DefaultVersion:=6
Sheets("Pivot").Select
Cells(1, 1).Select
With ActiveSheet.PivotTables("Statement1").CubeFields("[database].[Person]")
.Orientation = xlRowField
.Position = 1
End With
I could get the xlDistinctCount with this code:
ActiveSheet.PivotTables("Statement1").CubeFields.GetMeasure "[database].[TT]" _
, xlCount
ActiveSheet.PivotTables("Statement1").AddDataField ActiveSheet.PivotTables( _
"Statement1").CubeFields("[Measures].[quantity of items - TT]")
With ActiveSheet.PivotTables("Statement1").PivotFields( _
"[Measures].[quantity of items - TT]")
.Caption = "number of distinct items – TT"
.Function = xlDistinctCount
End With
I had to use the xlCount first and with this result could I get the xlDistinctCount.
I have recorded a macro for inserting a pivot. Since the macro is recorded it works fine with the specific excel sheet. But I want to generalize it such that it works on all sheets irrespective of the number of rows. So I want to select the 'N' column starting from 'N6' to the last filled cell. This I did using,
Range(Range("N5"), Range("N5").End(xlDown)).Select
But I want a dynamic destination for the pivot. It should be a couple of rows below the last filled rows in the sheet. How do I do that?
Sub Macro2()
Range("N6:N31").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R6C14:R31C14", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Sheet1!R38C11", TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion14
Sheets("Sheet1").Select
Cells(38, 11).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("BREAK TYPE")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("BREAK TYPE"), "Count of BREAK TYPE", xlCount
Range("K38").Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("BREAK TYPE")
.Orientation = xlRowField
.Position = 1
End With
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub
The code below checks for last row with data in Column N, then it checks if there is already a Pivot Table in "Sheet1".
If there is, it just refreshes the Pivot cache, according to updated Data.
If there isn't, it creates a PivotTable (2 rows under - Not Recommended).
Option Explicit
Sub Macro2()
Dim shtPivot As Worksheet
Dim PivotSrc_Range As Range
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Dim lastRow As Long
' modify to your Sheet name that holds the Pivot source data
Set shtPivot = ThisWorkbook.Sheets("Sheet1")
With shtPivot
lastRow = .Cells(.Rows.Count, "N").End(xlUp).Row
' setting dynamic Range in Column N
Set PivotSrc_Range = Range("N6:N" & lastRow)
' for debug
Debug.Print PivotSrc_Range.Address
End With
' set the Pivot Cache
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotSrc_Range, Version:=xlPivotTableVersion14)
' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl = shtPivot.PivotTables("PivotTable1")
On Error GoTo 0
If PvtTbl Is Nothing Then
' create a new Pivot Table in "Sheet1" sheet, start 3 rows below your last line with data
Set PvtTbl = shtPivot.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=shtPivot.Range("N" & lastRow + 3), TableName:="PivotTable1")
' modify the name in brackets according to your Pivot Fields
With PvtTbl.PivotFields("BREAK TYPE")
.Orientation = xlRowField
.Position = 1
End With
PvtTbl.AddDataField PvtTbl.PivotFields("BREAK TYPE"), "Count of BREAK TYPE", xlCount
Else
' just refresh the Pivot cache with the updated Range (data in Sheet1)
PvtTbl.ChangePivotCache PvtCache
PvtTbl.RefreshTable
End If
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub
I am not able to run this, I want to count total rows in sheet and pass that to pivot chart to create.
Pivot chart create
select fileds
Double click grand total to create new spread sheet
Sub Macro2()
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ActiveSheet
NewSheet = ActiveSheet.Name
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
ws & "!R1C1:R" & lastRow & "C15",
Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=NewSheet & "!R1C1", TableName:="PivotTable1",
DefaultVersion _
:=xlPivotTableVersion14
Sheets("NewSheet").Select
Cells(1, 1).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range("Sheet4!$A$1:$C$18")
ActiveSheet.Shapes("Chart 1").IncrementLeft 192
ActiveSheet.Shapes("Chart 1").IncrementTop 15
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Customer")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables(
_
"PivotTable1").PivotFields("Customer"), "Count of Customer", xlCount
ActiveWindow.SmallScroll Down:=12
Range("B29").Select
Selection.ShowDetail = True
End Sub'
The code below checks the data in Sheet1 (modify to your sheet name) and creates a Pivot Table and Chart in Sheet Report.
On first time it creates the Pivot Table and chart, from the second time it just refreshes the Pivot Cache with the updated rows of data (in Sheet1) and updates the Chart.
Sub Macro2()
Dim sht1 As Worksheet
Dim shtReport As Worksheet
Dim lastRow As Long
Dim PivotSrc_Range As Range
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
Dim Chart1 As Chart
' modify to your sheet name
Set sht1 = ThisWorkbook.Sheets("Sheet1")
' modify to your desired Pivot Table location
Set shtReport = ThisWorkbook.Sheets("Report")
' create the Source Range of the Pivot Cache
lastRow = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row
' it's looking uo tp Column "O" (15) as recorded in your MACRO
Set PivotSrc_Range = sht1.Range(sht1.Cells(1, 1), sht1.Cells(lastRow, 15))
' set the Pivot Cache
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotSrc_Range, Version:=xlPivotTableVersion14)
On Error Resume Next
Set PvtTbl = shtReport.PivotTables("PivotTable1")
On Error GoTo 0
If PvtTbl Is Nothing Then
' create a new Pivot Table in "Report" sheet, start from Cell A2
Set PvtTbl = shtReport.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=shtReport.Range("A2"), TableName:="PivotTable1")
' modify the name in brackets according to your Pivot Fields
With PvtTbl.PivotFields("Customer")
.Orientation = xlRowField
.Position = 1
End With
PvtTbl.AddDataField PvtTbl.PivotFields("Customer"), "Count of Customer", xlCount
Else
' just refresh the Pivot cache with the updated Range (data in Sheet1)
PvtTbl.ChangePivotCache PvtCache
PvtTbl.RefreshTable
End If
' check if already has a chart in sheet (from previous Macro Runs)
If shtReport.ChartObjects.Count >= 1 Then
Set Chart1 = shtReport.ChartObjects(1).Chart
Else ' first time >> create the chart
shtReport.Shapes.AddChart.Select
Set Chart1 = ActiveChart
End If
With Chart1
.ChartType = xlColumnClustered
.SetSourceData Source:=PvtTbl.TableRange1 ' refresh the chart with the updated Pivot Table
End With
End Sub