Insert Grouping Using Excel Object Model

[Mike C]

I can use the Excel Object Model to populate an Excel sheet using Access
data, but I hoping there's a way to insert grouping as I loop through
records. I have regions and products that I loop through and insert into the
Excel sheet. I was hoping to do this:

Add Region Grouping
Add region to excel sheet
Add Product Grouping
Add Products
End Prouduct Grouping
End Region Grouping

Add next territory grouping etc.

Here's a sample of my code below. Any thoughts would be absolutely
tremendous!! Thanks!

Set DB = CurrentDb

Set rsRecipients = DB.OpenRecordset("SELECT * FROM SalesDivision")

If Not rsRecipients.EOF Then
Do While Not rsRecipients.EOF

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("...Template.xls")

Set SheetSales = xlBook.Worksheets("Sales Dollars")
Set SheetUnits = xlBook.Worksheets("Sales Units")

a = 1 'horozontal axis
b = 2 'vertical axis

Set rsRegion = DB.OpenRecordset("SELECT * " & _
"FROM [SalesRegion] WHERE [DivisionID]= '" &
rsRecipients![DivisionID] & "' ORDER BY SalesRegion.Region")

a = a 'horozontal axis
b = b 'vertical axis

If Not rsRegion.EOF Then
Do While Not rsRegion.EOF

---> Insert Grouping?

Set rsProduct = DB.OpenRecordset("SELECT * " & _
"FROM [ProductC2IDa]")

i = a 'horozontal axis
j = b 'vertical axis

If Not rsProduct.EOF Then
Do While Not rsProduct.EOF

---> Insert Grouping?

i = i 'horozontal axis
j = j 'vertical axis

Set rsSales = DB.OpenRecordset("SELECT * " & _
"FROM [AnalyticsSalesRegion] WHERE [ProductH2IDa] = " &
[rsProduct].[ProductH2IDa] & " AND [RegionID]= '" & rsRegion![RegionID] & "'")

Set rsUnits = DB.OpenRecordset("SELECT * " & _
"FROM [AnalyticsUnitsRegion] WHERE [ProductH2IDa] = " &
[rsProduct].[ProductH2IDa] & " AND [RegionID]= '" & rsRegion![RegionID] & "'")

RegionName = rsSales("Region")
Product = rsSales("ProductH2IDaDesc")
Month1 = rsSales("2005-12")
Month2 = rsSales("2006-01")
Month3 = rsSales("2006-02")

SheetSales.Cells(j, i).Value = RegionName
SheetSales.Cells(j, i + 1).Value = Product
SheetSales.Cells(j, i + 2).Value = Month1
SheetSales.Cells(j, i + 3).Value = Month2
SheetSales.Cells(j, i + 4).Value = Month3

UnitsMonth1 = rsUnits("2005-12")
UnitsMonth2 = rsUnits("2006-01")
UnitsMonth3 = rsUnits("2006-02")

SheetUnits.Cells(j, i).Value = RegionName
SheetUnits.Cells(j, i + 1).Value = Product
SheetUnits.Cells(j, i + 2).Value = UnitsMonth1
SheetUnits.Cells(j, i + 3).Value = UnitsMonth2
SheetUnits.Cells(j, i + 4).Value = UnitsMonth3

j = j + 10
rsProduct.MoveNext
Loop
End If

a = a 'horozontal axis
b = b + 1 'vertical axis

---> End Grouping?

rsRegion.MoveNext
Loop
End If

xlApp.ActiveWorkbook.SaveAs "...rsRecipients("Division") & " Metrics.xls"

xlApp.ActiveWorkbook.Saved = True

Set SheetTEVendor = Nothing

xlApp.ActiveWorkbook.Close
xlApp.Quit

rsRecipients.MoveNext
Loop
End If

End Sub

 

[John Nurick]

It looks as if all you need do is, for each grouping level,

1) put any headings or labels in the appropriate cells and format them
as required
2) increment your "Row" counter(s) as required
3) write the actual data as now
4) put formulas for any group totals in the next available row(s) and
format the cells as required
5) increment the row counters and continue with the next group at that
level.

To get the VBA code for (1) and (4), I'd start by recording an Excel
macro while entering values, formulae and formatting manually; then
modify the code to work with Range objects rather than the Selection
object; and finally paste it into the Access module and make final
adjustments.

I can use the Excel Object Model to populate an Excel sheet using Access
data, but I hoping there's a way to insert grouping as I loop through
records. I have regions and products that I loop through and insert into the
Excel sheet. I was hoping to do this:

Add Region Grouping
Add region to excel sheet
Add Product Grouping
Add Products
End Prouduct Grouping
End Region Grouping

Add next territory grouping etc.

Here's a sample of my code below. Any thoughts would be absolutely
tremendous!! Thanks!

Set DB = CurrentDb

Set rsRecipients = DB.OpenRecordset("SELECT * FROM SalesDivision")

If Not rsRecipients.EOF Then
Do While Not rsRecipients.EOF

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("...Template.xls")

Set SheetSales = xlBook.Worksheets("Sales Dollars")
Set SheetUnits = xlBook.Worksheets("Sales Units")

a = 1 'horozontal axis
b = 2 'vertical axis

Set rsRegion = DB.OpenRecordset("SELECT * " & _
"FROM [SalesRegion] WHERE [DivisionID]= '" &
rsRecipients![DivisionID] & "' ORDER BY SalesRegion.Region")

a = a 'horozontal axis
b = b 'vertical axis

If Not rsRegion.EOF Then
Do While Not rsRegion.EOF

---> Insert Grouping?

Set rsProduct = DB.OpenRecordset("SELECT * " & _
"FROM [ProductC2IDa]")

i = a 'horozontal axis
j = b 'vertical axis

If Not rsProduct.EOF Then
Do While Not rsProduct.EOF

---> Insert Grouping?

i = i 'horozontal axis
j = j 'vertical axis

Set rsSales = DB.OpenRecordset("SELECT * " & _
"FROM [AnalyticsSalesRegion] WHERE [ProductH2IDa] = " &
[rsProduct].[ProductH2IDa] & " AND [RegionID]= '" & rsRegion![RegionID] & "'")

Set rsUnits = DB.OpenRecordset("SELECT * " & _
"FROM [AnalyticsUnitsRegion] WHERE [ProductH2IDa] = " &
[rsProduct].[ProductH2IDa] & " AND [RegionID]= '" & rsRegion![RegionID] & "'")

RegionName = rsSales("Region")
Product = rsSales("ProductH2IDaDesc")
Month1 = rsSales("2005-12")
Month2 = rsSales("2006-01")
Month3 = rsSales("2006-02")

SheetSales.Cells(j, i).Value = RegionName
SheetSales.Cells(j, i + 1).Value = Product
SheetSales.Cells(j, i + 2).Value = Month1
SheetSales.Cells(j, i + 3).Value = Month2
SheetSales.Cells(j, i + 4).Value = Month3

UnitsMonth1 = rsUnits("2005-12")
UnitsMonth2 = rsUnits("2006-01")
UnitsMonth3 = rsUnits("2006-02")

SheetUnits.Cells(j, i).Value = RegionName
SheetUnits.Cells(j, i + 1).Value = Product
SheetUnits.Cells(j, i + 2).Value = UnitsMonth1
SheetUnits.Cells(j, i + 3).Value = UnitsMonth2
SheetUnits.Cells(j, i + 4).Value = UnitsMonth3

j = j + 10
rsProduct.MoveNext
Loop
End If

a = a 'horozontal axis
b = b + 1 'vertical axis

---> End Grouping?

rsRegion.MoveNext
Loop
End If

xlApp.ActiveWorkbook.SaveAs "...rsRecipients("Division") & " Metrics.xls"

xlApp.ActiveWorkbook.Saved = True

Set SheetTEVendor = Nothing

xlApp.ActiveWorkbook.Close
xlApp.Quit

rsRecipients.MoveNext
Loop
End If

End Sub