Insert formula in non-blank cell Loop

[GeekMaster2000]

So, I have been plowing through the internet and haven't been able to find an answer to specifically help with this case.

I am building a relatively elaborate macro for my work and at one point I need to be able to insert a subtotal (sum) function when the cell contains a value (in this case, it will specifically always be the word "Total", if that helps) and the value in that cell needs to be replaced with the formula. In other words:

I have the following table:

Now, every time that in the column with the header "AJE" it says "Total", I want that cell to be replaced with the following formula => FormulaR1C1 "= SUBTOTAL(9,R9C5:R[-2]C) ". Or in other words, I want the formula to be a subtotal from the cell E9 until two cells above the active cell that has total written in it.

Then, I would like that formula to be copied and pasted (as a formula only) in certain other cells of the same row.

Then, I would like for this to be looped until E500 (since AJE is in column E) for each cell that contains Total.

What I have written at this point (which I know is wrong, but at least shows my intention) is the following (FYI, I left the 'Else' blank, because I don't want anything to happen if the cell is blank, just for it to run through the loop in the desired range):

Dim rngc As Range, c As Range
Set rngc = Range("E9:E500")
For Each c In rngc
If Not IsEmpty(cell) Then
Active.cell.FormulaR1C1 "= SUBTOTAL(9,R9C5:R[-2]C) "
Selection.Copy
ActiveCell.Offset(0, -1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Else
End If
Next c

The offset references are what need to have the formula pasted in there. This table can have much more than two totals, but will never go beyond the E500 range.

Any help is GREATLY appreciate it, have been trying to solve this for a while now!

 

[bebo021999]

Since your image does not support cell address info, I create a new sample, in which:
"Total" is in column E
Value is in column G,I,J,K, need to be subtotal per sub-group

Sub TEST()
For i = 9 To 18 'from beginning to end of range
    With WorksheetFunction
    If Range("E" & i).Value = "Total" Then
    Range("G" & i & ":K" & i).ClearContents
    Range("G" & i).Value = .Sum(Range("G9:G" & i)) - t1 ' grand total - running sum of subtotal
    Range("I" & i).Value = .Sum(Range("I9:I" & i)) - t2 ' grand total - running sum of subtotal
    Range("J" & i).Value = .Sum(Range("J9:J" & i)) - t3 ' grand total - running sum of subtotal
    Range("K" & i).Value = .Sum(Range("K9:K" & i)) - t4 ' grand total - running sum of subtotal
    t1 = t1 + Range("G" & i).Value * 2 ' running sum of subtotal of column G
    t2 = t2 + Range("I" & i).Value * 2 ' running sum of subtotal of column I
    t3 = t3 + Range("J" & i).Value * 2 ' running sum of subtotal of column J
    t4 = t4 + Range("K" & i).Value * 2 ' running sum of subtotal of column K
    End If
    End With
Next
End Sub

 

[GeekMaster2000]

Thank you soooooooo much!! That was the missting link. Since in the last row, it would not calculate the amount properly, because it is a grand total, I did the following (not a very elegant solution, but it works).

For i = 9 To 500 'from beginning to end of range
With WorksheetFunction
If Range("E" & i).Value = "Total" Then
Range("D" & i & ":L" & i).ClearContents
Range("D" & i).Value = .Sum(Range("D9:D" & i)) - t1 ' grand total - running sum of subtotal
Range("F" & i).Value = .Sum(Range("F9:F" & i)) - t2 ' grand total - running sum of subtotal
Range("G" & i).Value = .Sum(Range("G9:G" & i)) - t3 ' grand total - running sum of subtotal
Range("I" & i).Value = .Sum(Range("I9:I" & i)) - t4 ' grand total - running sum of subtotal
Range("J" & i).Value = .Sum(Range("J9:J" & i)) - t5 ' grand total - running sum of subtotal
Range("K" & i).Value = .Sum(Range("K9:K" & i)) - t6 ' grand total - running sum of subtotal
t1 = t1 + Range("D" & i).Value * 2 ' running sum of subtotal of column D
t2 = t2 + Range("F" & i).Value * 2 ' running sum of subtotal of column F
t3 = t3 + Range("G" & i).Value * 2 ' running sum of subtotal of column G
t4 = t4 + Range("I" & i).Value * 2 ' running sum of subtotal of column I
t5 = t5 + Range("J" & i).Value * 2 ' running sum of subtotal of column J
t6 = t6 + Range("K" & i).Value * 2 ' running sum of subtotal of column K
End If
End With
Next

Range("D500").Select
Selection.End(xlUp).Select
ActiveCell.FormulaR1C1 = "=SUM(R9C4:R[-2]C)/2"
Cells.Replace What:="$", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, _
FormulaVersion:=xlReplaceFormula2
Selection.Copy
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Wish you a great day!

 

[bebo021999]

Why not:

Sub TEST()
For i = 9 To 499 'from beginning to end of range
    With WorksheetFunction
    If Range("E" & i).Value = "Total" Then
    Range("G" & i & ":K" & i).ClearContents
    Range("G" & i).Value = .Sum(Range("G9:G" & i)) - t1 ' grand total - running sum of subtotal
    Range("I" & i).Value = .Sum(Range("I9:I" & i)) - t2 ' grand total - running sum of subtotal
    Range("J" & i).Value = .Sum(Range("J9:J" & i)) - t3 ' grand total - running sum of subtotal
    Range("K" & i).Value = .Sum(Range("K9:K" & i)) - t4 ' grand total - running sum of subtotal
    t1 = t1 + Range("G" & i).Value * 2 ' running sum of subtotal of column G
    t2 = t2 + Range("I" & i).Value * 2 ' running sum of subtotal of column I
    t3 = t3 + Range("J" & i).Value * 2 ' running sum of subtotal of column J
    t4 = t4 + Range("K" & i).Value * 2 ' running sum of subtotal of column K
    End If
Next
Range("G500").Value = .Sum(Range("G9:G499"))/2
Range("I500").Value = .Sum(Range("I9:I499"))/2
Range("J500").Value = .Sum(Range("J9:J499"))/2
Range("K500").Value = .Sum(Range("K9:K499"))/2
End With
End Sub