Need a macro to sum or subtotal ranges of varying lengths in a column

I've reached a point in this macro where I'm stuck with NO clue how to achieve this, or even whether it can be done. In the Before sheet below, I need to bold the cells in H & I if the word "Total" is in G. I could probably manage that part, but here's the weird part: I need to add a formula to H & I of each row with "Total" in G to sum the numbers above it, from the previous total down to the current total. But there's no telling how long each range might be on a given report; from 1 row up to 8 rows.

THEN, in the second row below the end of columns H & I, I need to put a formula totalling all of the preceding Totals

I wonder if there might be a way to tell it to put a formula in H by each cell that has "Total" in G, with the formula summing or subtotalling everything from the cell in H that has data in F to the cell just above the "Total". Any ideas?

I'm trying to attach a file; I hope it works!

Thanks!

Jenny

With the code below to fill the date.

Sub filldata_ascending_incolumnF_()

'from top to below (ascending)

    Range(Range("g12"), Cells(Rows.Count, 7).End(xlUp).Offset(, -1)). _
        SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    
End Sub

after that I made an table and after that a pivot table of the data.

also a graph is added to the file.

see the attached file.

Maybe:

Sub zookeepertx()
Dim i As Long
Dim rcell As Range
For i = Range("G" & Rows.count).End(3)(1).Row To 13 Step -1
    If Range("G" & i).Value = "Total" Then
        Range("H" & i).Clear
        Range("G" & i + 1).EntireRow.Insert
        Rows(i).Font.Bold = True
    End If
Next i
    For Each numrange In Range("H13:H" & Range("H" & Rows.count).End(3)(1).Row).SpecialCells(xlConstants, xlNumbers).Areas
        SumAddr = numrange.Address(False, False)
        numrange.offset(numrange.count, 0).Resize(1, 1).Formula = "=SUBTOTAL(9," & SumAddr & ")"
        numrange.offset(numrange.count, 0).Resize(1, 2).Formula = "=SUBTOTAL(9," & SumAddr & ")"
        c = numrange.count
    Next numrange
     
NoData:
Range("G13:G" & Range("G" & Rows.count).End(3)(1).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For Each rcell In Range("H13:I" & Range("G" & Rows.count).End(3)(1).Row)
    rcell.Font.Size = rcell.offset(-1).Font.Size
    rcell.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    If rcell.offset(, -1).Value = "Total" Then
        rcell.offset(, 2).Value = rcell.Value
        rcell.offset(, 3).Value = rcell.offset(, 1).Value
    End If
Next rcell
With Range("H" & Rows.count).End(3)(3)
    .Formula = "=SUM(J13:J31)"
    .Value = .Value
    .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
End With
With Range("I" & Rows.count).End(3)(3)
    .Formula = "=SUM(K13:K31)"
    .Value = .Value
    .NumberFormat = "#,##0.00_);[Red](#,##0.00)"

End With
Range("J13:K31").ClearContents
End Sub

Another question:

This report has a lot of data after this Summary section that's at the top. This data is formatted completely different from the Summary section. So, in my larger macro that I want to add this to, I've set SL as the row that has "Grand Total" in column F, denoting the end of the Summary section. (I totally forgot to include the Grand Total line before. VERY sorry!) So, I changed the coding to this:

Sub zookeepertx()
Dim i As Long
Dim rcell As Range
Dim SL As Range
Set SL = Range("F:F").Find("Grand Total")

For i = Range("G" & SL.Row - 3)(3)(1).Row To 13 Step -1
    If Range("G" & i).Value = "Total" Then
        Range("H" & i).Clear
        Range("G" & i + 1).EntireRow.Insert
        Rows(i).Font.Bold = True
    End If
Next i
    For Each numrange In Range("H13:H" & SL.Row - 3).SpecialCells(xlConstants, xlNumbers).Areas
        SumAddr = numrange.Address(False, False)
        numrange.Offset(numrange.Count, 0).Resize(1, 1).Formula = "=SUBTOTAL(9," & SumAddr & ")"
        numrange.Offset(numrange.Count, 0).Resize(1, 2).Formula = "=SUBTOTAL(9," & SumAddr & ")"
        c = numrange.Count
    Next numrange
     
NoData:
Range("G13:G" & Range("G" & Rows.Count).End(3)(1).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For Each rcell In Range("H13:I" & Range("G" & Rows.Count).End(3)(1).Row)
    rcell.Font.Size = rcell.Offset(-1).Font.Size
    rcell.NumberFormat = "#,##0.00_);[Red] (#,##0.00)"
    If rcell.Offset(, -1).Value = "Total" Then
        rcell.Offset(, 2).Value = rcell.Value
        rcell.Offset(, 3).Value = rcell.Offset(, 1).Value
    End If
Next rcell
With Range("H" & Rows.Count).End(3)(3)
    .Formula = "=SUM(9,H13:H31)"
End With
With Range("I" & Rows.Count).End(3)(3)
    .Formula = "=SUM(9,I13:I31)"
End With
Range("J13:K31").ClearContents
End Sub

But that gives me the result in the After tab on the newly attached workbook.

I also tried replacing all of the

Rows.Count).End

with

SL.Row - 3)

to try to confine the activity of the macro to the Summary section. But that caused the Grand Total line to move up directly below the last Total line, with H & I containing some HUGE number more than twice what you'd get if you summed ALL the lines above it & then added another line right below that which sums all the data above (giving twice the total needed, so obviously THAT'S wrong!

I'm going to be SO happy with this when it's done, but it sure is a process getting there, LOL!
Thanks!

Jenny

Hi John,
I'm back! Had to take care of some month-end work.

I wanted to confine the macro to just the top section of the worksheet - the Summary section. So, I made a couple of additions to your already awesome code! I want it to stop when it gets to the row with "Grand Total" in column F. So, here's what I have now:

Sub zookeepertx()
Dim i As Long
Dim x As Long
Dim rcell As Range
Dim SL As Range
Set SL = Range("F:F").Find("Grand Total")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
x = Range("G" & SL.Row - 3)(3)(4).Row
Range("F" & x).Resize(, 4).Cut Range("A" & x)
For i = Range("G" & SL.Row - 3)(3)(1).Row To 13 Step -1
    If Range("G" & i).Value = "Total" Then
        Range("H" & i).Clear
        Range("G" & i + 1).EntireRow.Insert
        Rows(i).Font.Bold = True
    End If
Next i
    For Each numrange In Range("H13:H" & Range("H" & SL.Row - 3)(3)(1).Row).SpecialCells(xlConstants, xlNumbers).Areas
        SumAddr = numrange.Address(False, False)
        numrange.Offset(numrange.Count, 0).Resize(1, 1).Formula = "=SUBTOTAL(9," & SumAddr & ")"
        numrange.Offset(numrange.Count, 0).Resize(1, 2).Formula = "=SUBTOTAL(9," & SumAddr & ")"
        c = numrange.Count
    Next numrange
     
NoData:
Range("G13:G" & Range("G" & SL.Row - 3)(3)(1).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For Each rcell In Range("H13:I" & Range("G" & SL.Row - 3)(3)(1).Row)
    rcell.Font.Size = rcell.Offset(-1).Font.Size
    rcell.NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    If rcell.Offset(, -1).Value = "Total" Then
        rcell.Offset(, 2).Value = rcell.Value
        rcell.Offset(, 3).Value = rcell.Offset(, 1).Value
    End If
Next rcell
With Range("H" & SL.Row - 3)(3)(7)
    .Formula = "=SUM(J13:J31)"
    .Value = .Value
    .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
End With
With Range("I" & SL.Row - 3)(3)(7)
    .Formula = "=SUM(K13:K31)"
    .Value = .Value
    .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
End With
Range("A" & SL.Row - 3)(3)(1).Resize(, 4).Cut Range("F" & Range("A" & SL.Row - 3)(3)(1).Row)
Range("J13:K31").ClearContents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

My only remaining problem is that, near the end of the code, it specifies J13:J31, which is how long the section is on the workbook I posted. But the Summary section is always longer than that, I just never know HOW long it's going to be. I tried replacing "=SUM(J13:J31)" with "=SUM("J13:J" & SL.Row - 3)", but that gives me a Compile error: Expected: end of statement on the J13. So, apparently, I can't use the SL.Row - 3 there or else I've got the syntax wrong. Ideas?

Thank you for your help!

Jenny

Edited: I got the Compile error to go away by using double quotes around J13:J. So, now it recognizes the SL.Row - 3, but it seems to want to back up too many lines. So, on the line that cuts the empty rows, it cuts clear up & includes the last Total row. And the Grand Totals return #NAME, plus the last cells in J and K don't get cleared. I'm not sure what I did wrong, but I'll attach the latest version of the workbook. And, now the end of the code looks like this:

Next rcell
With Range("H" & SL.Row - 3)(3)(7)
    .Formula = "=SUM(""J13:J"" & SL.Row - 3)"
    .Value = .Value
    .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
End With
With Range("I" & SL.Row - 3)(3)(7)
    .Formula = "=SUM(""K13:K"" & SL.Row - 3)"
    .Value = .Value
    .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
End With
Range("A" & SL.Row - 3)(3)(1).Resize(, 4).Cut Range("F" & Range("A" & SL.Row - 3)(3)(1).Row)
Range("J13:K" & SL.Row - 3).ClearContents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Also, I'm curious - in this line of code:

With Range("H" & SL.Row - 3)(3)(7)

what does the (3)(7) mean? I'm thinking that might be part of my problem, but I can't figure it out.

Jenny