Rhb

P" Replace current subtotals 0 Page break between groups H Summary below data

P" Replace current subtotals 0 Page break between groups H Summary below data

If you were sure that you would always have three regions and a total, the code to add subtotals for each product group would be ' Add Subtotals by Product.

1 Be sure to add a page break at each change in product

Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3, 4, 5, 6), _ PageBreaks:=True

However, this code fails if you ever have a day where one region has no sales and is not included in the report, or if a new region is added to the company. The solution is to use this convoluted code to dynamically build a list of the columns to total, based on the number of columns in the report:

Dim TotColumns()

FinalCol = Cells(3, 255).End(xlToLeft).Column ReDim Preserve TotColumns(1 To FinalCol - 2) For i = 3 To FinalCol

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:

1 Make sure the columns are wide enough for totals GrandRow = Range("A65536").End(xlUp).Row Cells(GrandRow, 3).Resize(1, 4).Columns.AutoFit Cells(GrandRow, 3).Resize(1, 4).NumberFormat = "#,##0,K" ' Add a page break before the Grand Total row, otherwise 1 the product manager for XYZ will have two totals WSR.HPageBreaks.Add Before:=Cells(GrandRow, 1)

0 0

Post a comment