View Full Version : [SOLVED] VBA Code to add groupings to subtotals

Steve Belsch
12-04-2019, 10:51 AM
I have code that creates subtotals. Is there a way to group (i.e. Data tab Group function) each subtotal with VBA? Any ideas?

Here is the code for subtotals...

i = 3
J = i
'Sort the data so like data is grouped together.
Range("A5").CurrentRegion.Offset(1).Sort Range("A12"), 1
'Loops throught Col A Checking for match then when there is no match add Sum
Do While Range("A" & i) <> ""
If Range("A" & i) <> Range("A" & (i + 1)) Then
Rows(i + 1).Insert
Range("A" & (i + 1)) = "Subtotal " & Range("A" & i).Value
For iCol = 13 To 73 'Columns to Sum
Range(Cells(i + 1, 13), Cells(i + 1, 73)).FormulaR1C1 = "=SUBTOTAL(9,R" & J & "C:R[-1]C)"
Next iCol
Range(Cells(i + 1, 1), Cells(i + 1, 73)).Font.Bold = True
Range(Cells(i + 1, 1), Cells(i + 1, 73)).BorderAround ColorIndex:=1

i = i + 2
J = i
i = i + 1
End If

12-04-2019, 01:02 PM
Have another go at attaching a file.

Steve Belsch
12-04-2019, 02:02 PM

I have attached a simple example of what I am looking to accomplish. My goal is to create the subtotals with the VBA look included in this thread. But to then create these + and - grouping for the rows for each of those subtotals.

Thank you.


12-04-2019, 03:29 PM
After the BorderAround line add:
Rows(j & ":" & i).Rows.Group

Your code doesn't seem to apply very well to your sample data. Every line is different. Your summing blank columns.

ps. You don't need the For iCol = 13 To 73 loop, just keep the single line in the middle of the loop.

Steve Belsch
12-05-2019, 10:37 AM

Thanks for the reply. Good catch. But actually I sent you just a small sample. My worksheet is large so I just sent a sample. In the version that I am using it needs to sum those columns. Sorry I was not clear on that point.

I am just searching for a way to add in groupings for each subtotal (the + and - on the left side, left of the row numbers). Not sure if that is possible with VBA?

Any ideas?

12-05-2019, 02:51 PM
The first 2 lines of my last response (msg#4) do that.
With the data you supplied in column A, every row is different from the row above it so it will give subtotals after every row and you may not get grouping of single rows.

Steve Belsch
12-06-2019, 11:08 AM

This an example of the entire worksheet that I am trying to group by subtotals with VBA. Does this help? Or is it not possible to do this with VBA?


12-06-2019, 11:49 AM
Why don't you do as I suggest?!
The attached has that one line added. Run the amended-as-suggested macro by clicking the button on the sheet at cell H2. I've removed existing subtotals and cleared the existing outline (grouping) from the sheet.

Note that you have placed a completely blank column at column AA so the currentregion part of the line:
Range("A5").CurrentRegion.Offset(1).Sort Range("A12"), 1
means that sorting only takes place to the left of that column. Columns to the right of that column will remain as they were.

Steve Belsch
12-06-2019, 12:22 PM

AWESOME! Thanks so much. Solved.

As far as the sort. Maybe I am not sure what I am doing. I can populate AA but maybe the range A5 and A12 doesn't make sense?

12-06-2019, 12:41 PM
You only need to populate one cell preferably the header row at AA2; put the word blank or something in it, and if you don't want to see it make its font white.
Consider whether you need to do the same at AD2 and BU2.

As for A5 and A12, it should be alright in this case but:
Range("A2").CurrentRegion.Offset(1).Sort Range("A2"), 1
might be better.

Steve Belsch
12-06-2019, 01:26 PM
Ok. Thanks again.