PDA

View Full Version : Solved: Pivot Table



qcoleman
12-30-2012, 06:31 PM
I'm trying to find a way to create a pivot table from a worksheet (i.e. "Monthly Data"), but i'm having a little trouble with code.

Sub Pivot()
Sheets.Add
ActiveSheet.Name = "Monthly Data"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Master!R1C1:R5038C37", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Sheet26!R3C1", TableName:="PivotTable4", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Sheet26").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Created By Name")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Status"), "Count of Status", xlCount
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Count of Status")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Created"), "Count of Created", xlCount
Range("C4").Select
ActiveSheet.PivotTables("PivotTable4").PivotFields("Status").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
Range("D4").Select
ActiveSheet.PivotTables("PivotTable4").RowGrand = False
Range("C4").Select
ActiveSheet.PivotTables("PivotTable4").PivotFields("Status").PivotItems( _
"Opened").Position = 1
End Sub

Aflatoon
12-31-2012, 03:46 AM
What trouble are you having exactly?

Paul_Hossler
12-31-2012, 06:41 AM
And a sample WB with a bit of data would be helpful also


Paul

werafa
01-02-2013, 03:20 PM
Paul, here is how I have gone about it.
From the 'Master' sub:
Call CreatePivotSheet(pivotName, mySheetName, myUtility, mySheet, myPivot)
Set mySheet = Worksheets(mySheetName)

Call PopulatePivot1
Call FilterPivot(myPivot, "Fin Year")
Call SetPivotNumberFormat
Call SetPivotQuarters(myPivot, myUtility)
Call SortPivotData(myPivot)

then to add data:
Sub PopulatePivot1()
'Adds data to pivot for Chart Data

With myPivot
.PivotFields("Fin Quarter").Orientation = xlPageField
.PivotFields("Property Name").Orientation = xlRowField
.AddDataField .PivotFields("Consumption (kWh)"), "Sum of Consumption (kWh)", xlSum
.AddDataField .PivotFields("Total $"), "Sum of Total $", xlSum
.CalculatedFields.Add "%_Est", "='kWh Estimated'/'Consumption (kWh)'", True
.PivotFields("%_Est").Orientation = xlDataField
.RowGrand = False
With .PivotFields("Fin Year")
.Orientation = xlColumnField
.Position = 2
End With
.CompactLayoutColumnHeader = "Fin. Year Filter"
.DisplayErrorString = True
End With
End Sub

Sub SetPivotNumberFormat()
' set number format for pivot table 1
With myPivot
.PivotFields("Sum of Consumption (kWh)").NumberFormat = "0"
.PivotFields("Sum of Total $").NumberFormat = "$#,##0"
.PivotFields("Sum of %_Est").NumberFormat = "0%"
End With
End Sub

Sub FilterPivot(myPivot As PivotTable, myField As String)
'
' sets the filter on the 'Year' data field
' sheet is limited to two year items

Dim myItem As Long
Dim lastItem As Long

With myPivot.PivotFields(myField)
.AutoSort xlAscending, myField
lastItem = .PivotItems.Count
If lastItem > 0 Then
For myItem = 1 To lastItem - 2
.PivotItems(myItem).Visible = False
'could send myitem.name to an array from here if needed
Next myItem
Else
MsgBox ("error setting year filters")
End If
End With
End Sub

Sub SetPivotQuarters(myPivot As PivotTable, myUtility As String)
' get max quarter for most recent year
' then set remaining quarters to visible = false

Dim dataSheet As Worksheet
Dim myYear As String
Dim myRange As Range
Dim maxQ As Long
Dim myRow As Long
Dim lastRow As Long
Dim finYCol As Long
Dim finQCol As Long
Dim myInt As Long

Set dataSheet = Worksheets(myUtility & "_Data")
Set myRange = dataSheet.UsedRange

'find correct column numbers
finYCol = FindColumn("Fin Year", dataSheet)
finQCol = FindColumn("Fin Quarter", dataSheet)

lastRow = myRange.Rows.Count
myInt = myPivot.PivotFields("Fin Year").PivotItems.Count
myYear = myPivot.PivotFields("Fin Year").PivotItems(myInt) 'get name of last item

'Find most recent quarter of most recent year
For myRow = 2 To lastRow
If myRange.Cells(myRow, finYCol).Value = myYear Then
maxQ = WorksheetFunction.Max(maxQ, myRange.Cells(myRow, finQCol).Value)
End If
If maxQ = 4 Then Exit For
Next myRow

If maxQ < 4 Then
myPivot.PivotFields("Fin Quarter").EnableMultiplePageItems = True
For myInt = maxQ + 1 To 4
myPivot.PivotFields("Fin Quarter").PivotItems(myInt).Visible = False
Next myInt
End If

On Error Resume Next
myPivot.PivotFields("Fin Quarter").PivotItems("(blank)").Visible = False
On Error GoTo 0

Set dataSheet = Nothing
Set myRange = Nothing
End Sub

I may have missed a few bits, but this should get you started. Also, see http://peltiertech.com/WordPress/referencing-pivot-table-ranges-in-vba/ for a good explanation of pivot objects

regards

werafa
01-02-2013, 03:21 PM
and
Sub SortPivotData(myPivot As PivotTable)
'sort pivot by 2nd column (most recent year)
'in "Sum of Consumption" pivot range

Dim myField As PivotField

For Each myField In myPivot.RowFields
myField.AutoSort xlDescending, "Sum of Consumption (kWh)", _
myPivot.PivotColumnAxis.PivotLines(2), 1
Next myField
Set myField = Nothing
End Sub

werafa
01-02-2013, 03:24 PM
As a suggestion, break your code down in to sub modules - advice I like is to have one logical step per sub, and to keep it all visible on one screen. My logic was to create a blank pivot, then ad data, then filter, then sort. I have one set of row headings, and three sets of column headings, each with two columns (two years worth of data)

werafa
01-02-2013, 03:31 PM
You might need this one as well

Sub CreatePivotSheet(pivotName As String, mySheetName As String, _
myUtility As String, mySheet As Worksheet, myPivot As PivotTable)
' Creates a new sheet, names it
' adds a blank pivot table (sets input data range and name)
' then returns the new sheet as an object

Dim inputSheet As Worksheet
Dim inputSheetName As String
Dim myUsedRange As String
Dim lastRow As Long
Dim lastCol As Long

Call DeleteSheet(mySheetName)
inputSheetName = myUtility + "_Data"
Set inputSheet = Worksheets(inputSheetName)

'define input data range for Pivot
Do While inputSheet.Range("A1").Value = "" 'remove blank leading rows
Columns(1).Delete
Loop
lastRow = inputSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lastCol = inputSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
myUsedRange = inputSheetName & "!R1C1:R" & lastRow & "C" & lastCol

Set mySheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
mySheet.Name = mySheetName

'Create blank Pivot Table & set source data range
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=myUsedRange, _
Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:="Elec_Pivot!R1C1", _
tableName:=pivotName, DefaultVersion:=xlPivotTableVersion14

Set myPivot = mySheet.PivotTables(1)
Set inputSheet = Nothing
End Sub

qcoleman
01-02-2013, 07:46 PM
Thank you All for your help! I finally got it to work perfectly.