# range problem with multiple use of subtotal function

L

#### Laurisa.Prince

Hi, I'm hoping someone can help me. I'm working with Excel97.
Using the subtotal function, is there a way to find the number of rows
that now exist after the subtotal has done its' magic?
Problems/reasons below...

I'm seeking to automate creating subtotals on a spreadsheet. Here is a
snippet of the code I'm working with:

' Clear all subtotals
Cells.Select
Selection.RemoveSubtotal
' Select range of data
Range("labor_test").Select
' Do first subtotal
Selection.Subtotal GroupBy:=1, Function:=xlSum,
TotalList:=Array(8, 9), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'(THIS IS WHERE I HAVE THE PROBLEM)
' Do the next subtotal
Selection.Subtotal GroupBy:=2, Function:=xlSum,
TotalList:=Array(8, 9), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True

My problem is that doing this via VBA, it seems to not be able to
figure out what the range is supposed to be for the second subtotal -
it seems to think the range is short by the number of subtotal rows
and it misbehaves and creates extra subtotal lines. When I use the
pulldown on the toolbar under Data, Subtotals, it keeps track of the
selection range and has the right number of rows highlighted when I go
to repeat the proceedure. I did use the macro recorder, but what you
see above is exactly what it gave me.
Thanks!!!

D

#### Debra Dalgleish

Even if you create the second set of subtotals manually, you get a
second grand total row. I don't think you can avoid the duplicates when
you create the subtotals programmatically.

L

#### Laurisa.Prince

Thanks for the reply. I don't mind seeing multiple grand total liine,
what I minded was the fact that when the second subtotal executed, it
only used part of the data and left 15% of the data hanging out on the
other side of the second subtotal, thus creating garbage data.
However, I was able to fix my problem by looking at other people's
questions/answers dealing with subtotals and finding a way to reset
the range.

Here's what I ended up doing:

ActiveWorkbook.Worksheets("WORKSHEET_A").Activate
Set awks = ActiveSheet
' Which columns do I want subtotals for?
intcol(1) = 1
intcol(2) = 2
intcol(3) = 4
intcol(4) = 6

With awks
Cells.Select
Selection.RemoveSubtotal
For i = 1 To 4
' Find the bottom non empty cell to reset the range to the whole
selectionn
lastrow = .Cells(.Rows.Count, "A").End(xlUp).row
Set rng = .Range("a1:j" & lastrow)
rng.Select
' If first time through, have replace be true (probably redundant)
If i = 1 Then
breplace = True
Else
breplace = False
End If
' Do subtotal on group/column
Selection.Subtotal GroupBy:=intcol(i), Function:=xlSum, _
TotalList:=Array(8, 9), Replace:=breplace, _
PageBreaks:=False, SummaryBelowData:=True
Next
' Roll everything up
.Outline.ShowLevels RowLevels:=5
.Outline.ShowLevels RowLevels:=4
.Outline.ShowLevels RowLevels:=3
.Outline.ShowLevels RowLevels:=2
End With