Dim TotColumns()
Dim I as Integer
FinalCol = Cells(3, Columns.Count).End(xlToLeft).Column
ReDim Preserve TotColumns(1 To FinalCol - 2)
For i = 3 To FinalCol
TotColumns(i - 2) = i
Next i
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=TotColumns,_
Replace:=True, PageBreaks:=True, SummaryBelowData:=True
Finally, with the new totals added to the report, you need to autofit the numeric columns
again with this code:
Dim GrandRow as Long
‘ Make sure the columns are wide enough for totals
GrandRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(3, 3).Resize(GrandRow - 2, FinalCol - 2).Columns.AutoFit
Cells(GrandRow, 3).Resize(1, FinalCol - 2).NumberFormat = “#,##0,K”
‘ Add a page break before the Grand Total row, otherwise
‘ the product manager for the final Line will have two totals
WSR.HPageBreaks.Add Before:=Cells(GrandRow, 1)
Putting It All Together
Listing 11.3 produces the product line manager reports in a few seconds.
Listing 11.3 Code That Produces the Product Line Report in Figure 11.11
Sub ProductLineReport()
‘ Product and Market as Row
‘ Years as Column
Dim WSD As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim FinalRow As Long
Dim TotColumns()
Set WSD = Worksheets(“PivotTable”)
Dim WSR As Worksheet
Dim WBO As Workbook
Dim WBN As Workbook
Set WBO = ActiveWorkbook
‘ Delete any prior pivot tables
For Each PT In WSD.PivotTables
PT.TableRange2.Clear
Next PT
WSD.Range(“R1:AZ1”).EntireColumn.Clear
‘ Define input area and set up a Pivot Cache
FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
FinalCol = WSD.Cells(1, Columns.Count). _
End(xlToLeft).Column
Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
xlDatabase, SourceData:=PRange.Address)
Chapter 11 Using VBA to Create Pivot Tables
254
11
12_0789736012_CH11.qxd 12/11/06 6:26 PM Page 254
To Next Page
Loading...
Need help?
General
