Creating a group with VBA is a bit quirky. The .Group method can be applied to only a single cell in the pivot table and that cell must contain a date or the ShipDate label. This is the first example in this chapter where you must allow Excel to calculate an intermediate pivot table result.

You must define a pivot table with ShipDate in the column field. Turn off ManualCalculation to allow the ShipDate field to be drawn. You can then use the LabelRange property to locate the ShipDate label and group from there. The code to produce Figure 12.31 follows:

Sub ReportByMonth()

Dim WSD As Worksheet Dim PTCache As PivotCache Dim PT As PivotTable Dim PRange As Range Dim FinalRow As Long

Set WSD = Worksheets("Pivot Table")

1 Delete any prior pivot tables For Each PT In WSD.PivotTables

PT.TableRange2.Clear Next PT

1 Define input area and set up a Pivot Cache FinalRow = WSD.Cells(65536, 1).End(xlUp).Row Set PRange = WSD.Cells(1, 1).Resize(FinalRow, 8)

Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address)

Set PT = PTCache.CreatePivotTable(TableDestination:=WSD.Range("J2"),

TableName:="PivotTable1") PT.ManualUpdate = True ' Set up the row fields

PT.AddFields RowFields:="ShipDate", ColumnFields:="Region"

With PT.PivotFields("Revenue") .Orientation = xlDataField .Function = xlSum .Position = 1 .NumberFormat = "#,##0" .Name = "Total Revenue" End With

1 Ensure that we get zeroes instead of blanks in the data area PT.NullString = "0"

' Calc the pivot table to allow the ShipDate label to be drawn PT.ManualUpdate = False PT.ManualUpdate = True

1 Group ShipDate by Month, Quarter, Year

PT.PivotFields("ShipDate").LabelRange.Group Start:=True, _ End:=True, Periods:= _

Array(False, False, False, False, True, True, True)

' Calc the pivot table PT.ManualUpdate = False PT.ManualUpdate = True

End Sub

0 0

Post a comment