VBA Excel - Inserting Subtotal Formulas into Speci

Question

My issue is kind of a blend of what's happening here and here, but is very much neither. I've got a weird dataset that is structured more like a hierarchy than a pure series of data points. Something like this:

Item                           Budget      Sales
GROUP - Cats                      0         120
FY 13 Persian                     0           0
FY 13 Maine Coon                 12           0
FY 14 Maine Coon                 50           0
FY 12 Tabby                       1           0
FY 13 Tabby                       1           0
FY 14 Tabby                       2           0
FY 14 Alley                      12           0
GROUP - Dogs                      0         201
FY 14 Collie                     20           0
FY 14 Lab                        31           0
FY 13 Golden Retriever           12           0
FY 12 Golden Retriever            0           0
GROUP - Gold Fish                 0          50
FY 14 Goldfish                  100           0
FY 13 Clown Fish                 20           0
Tanks Fees                      150           0

I need a macro that can neatly identify the GROUP lines and then sum the group underneath it -- without capture the next group. In other words, I need the cat budget line to sum only the cat budgets.

So the macro would need to identify the line with the "GROUP*", then search down until it finds the next "GROUP*", and sum the space in between Cats and Dogs -- preferably as a function -- on the "GROUP - Cats" line.

I know this has to be possible, but I'm worried it's too complicated for my basic abilities in VBA.

EDIT: The end product would be a formula in the Budget column that is simply =SUM(B3:B9). Then B10 (the Dogs GROUP) would have a formula such as =SUM(B11:B14). For Gold Fish: =SUM(B16:18).

But since each my dataset is always changing (for instance, this week there may be 20 lines in the Cats section instead of 18 the previous week), I need a macro that can find the space between the GROUP lines.

EDIT 2: The VBA I'm using currently does something similar to what I'm looking for -- it essentially groups and collapses my sections based on the numbers that appear in the Sales column:

Dim rStart As Range, r As Range
Dim lLastRow As Long, sColumn As String
Dim rColumn As Range
'### The Kittens everywhere! thing is just to make sure the last group has an end point
Range("C1").End(xlDown).Offset(1).Value = "Kittens everywhere!"
    sColumn = "C"

With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlRight

lLastRow = Cells(Rows.Count, sColumn).End(xlUp).Row
With ActiveSheet
    Set rColumn = .Range(.Cells(1, sColumn), Cells(lLastRow, sColumn))
    With rColumn
        Set r = .Cells(1, 1)
        Do Until r.Row > lLastRow
            If rStart Is Nothing Then
                If r.Value = "0" Then
                    Set rStart = r
                End If
            Else
                If r.Value <> "0" Then
                    Range(rStart, r.Offset(-1, 0)).Rows.Group
                    Set rStart = Nothing
                End If
            End If
            Set r = r.Offset(1, 0)
        Loop
    End With
End With
ActiveSheet.Outline.ShowLevels RowLevels:=1
End With

Range("C:C").Find("Kittens everywhere!").ClearContents

There's more to the macro -- because it's also doing some things like highlighting the GROUP rows -- but I'm sure if I can jam this SUM function stuff into that section or not.

Answer 1

This is a suggestion that may or may not be appropriate but it does offer an option for you. It uses the built in Excel SubTotal function. There are some pros and cons (see below).

It requires two Subs, one to apply SubTotals:

Sub STPets()
Dim ws As Worksheet
Dim strow As Long, endrow As Long, stcol As Long, endcol As Long
Dim drng As Range

strow = 3
stcol = 3  'Col C
endcol = 6  'Col F

Set ws = Sheets("Sheet1")

    With ws
        'find last data row
        endrow = Cells(Rows.Count, stcol).End(xlUp).Row

        'sort data
        Set drng = .Range(.Cells(strow, stcol), .Cells(endrow, endcol))
        drng.Sort Key1:=.Cells(strow + 1, stcol), Order1:=xlAscending, Header:=xlYes

        'apply Excel SubTotal function
        .Cells.RemoveSubtotal
        drng.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(3)

    End With

End Sub 

and one to Clear e.g. to add more data:

Sub RemoveSTPets()
Dim ws As Worksheet

Set ws = Sheets("Sheet1")
ws.Cells.RemoveSubtotal

End Sub

The data can be totalled and cleared at will, by using two buttons assigned to these macros:

As you can see it requires a slight re-arrangement of your data but arguably this makes it more flexible and consistent with database format (looking to the future?). It is also arguably easier to add new data anywhere in the list and easier to add/change groups (Codes) i.e. Clear > Add more data > re-Total. You can customise further in accordance with the Excel SubTotal functionality.

Finally, at the risk of overstepping the brief, but further food for thought perhaps - it might also be a good idea to separate-out your 'FY 13' and 'FY 14' identifiers into a separate "FY" column. You may then find it more flexible to do further analysis on your data over time.