Pivot Table Macro

Visual Basic for Applications (VBA)

GB Allan


Hi,

I have set up a small macro to create a pivot table from a spreadsheet:

Sub CreatePivot()
'
' CreatePivot Macro
' Macro recorded 3/14/2007 by Gary

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Data!R1C1:R656C90").CreatePivotTable TableDestination:="", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Pivot"

End Sub

The problem is that each spreadsheet I run it on, has a different number of rows. They all have the same number of columns (A-CL), but the number of rows varies. I'd like the pivot to work no matter how many rows it is: i.e., that it will automatically select the entire range whatever it is. Is this doable

Thank you,

Gary
Top

Re: Pivot Table Macro

Navajo


Gary,

You should be able to get the last row used on a sheet using code similar to:

lastRow = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row 'get last row of data (in column 6)

then you can use "=Data!$A$1:$CL$" & lastRow to set the SourceData of the Pivot Cache


Whenever I've worked with pivot tables in VBA I've found it easier to work with PivotTable & PivotCache objects. The code excerpt below shows how and should give some ideas:


Public Sub Pivot_OrderNumDate()
Dim WBPivot As Workbook
Dim lastRow As Long
Dim ptRng As Range
Dim PC1 As PivotCache
Dim PT1 As PivotTable

On Error GoTo PivotErr

Set WBPivot = ThisWorkbook

lastRow = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row 'get last row of data (in column 6)

WBPivot.Names.Add Name:="Database", RefersTo:="=Sheet1!$A$1:$F$" & lastRow 'add a named range set to data range
Set ptRng = Cells(lastRow + 4, 1) 'Pivot table is placed 4 rows below data

'create pivot cache & table
Set PC1 = WBPivot.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="Database")
Set PT1 = PC1.CreatePivotTable(tabledestination:=ptRng, tablename:="PT1", defaultversion:=xlPivotTableVersion10)

With PT1
.ColumnGrand = False
.RowGrand = False
.AddFields RowFields:=Array("Order no", "Item code", "Description", "Customer no", "Date")
With .PivotFields("Duration")
.Orientation = xlDataField
.Caption = "Sum of Duration"
.Function = xlSum
.NumberFormat = "Cool:mm" '(hours:minutes!)
End With
.PivotFields("Customer no").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
End With

ActiveSheet.Columns("A:F").AutoFit
Set PT1 = Nothing
Set PC1 = Nothing
Set WBPivot = Nothing

Exit Sub
PivotErr:
MsgBox "Error" & vbCrLf & Err.Number & vbCrLf & Err.Description, vbCritical, "Pivot table"

End Sub


Top

Re: Pivot Table Macro

GB Allan

Thank you Navajo - I will try what you suggested.

Gary



Top

Re: Pivot Table Macro

GB Allan

It works. Thanks again. Here's the final code I used:

Sub CreatePivot()

' CreatePivot Macro
' Macro recorded 3/23/2007 by


Dim lastRow As Long


lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'get last row of data (in column 1)

ActiveWorkbook.Names.Add Name:="Database", RefersTo:="=Data!$A$1EmbarrassedCL$" & lastRow 'add a named range set to data range

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Database").CreatePivotTable tabledestination:="", tablename:= _
"PivotTable1", defaultversion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard tabledestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Pivot"

End Sub

Gary


Top
  • The team •