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.
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.