VBA Formula to create Subtotals

[Michael M]

Hi
I currently use this to create a formula in column "G" wherever there is a bold cell, and it SUMS up as far as the next Bold cell, -1 row.

How do I change the code to SUM down to the next Bold cell,-1 row.
I simply can't get my head around this, at the moment.

s = 13
For Each r In Range("G13:G" & lrow) 'ADDS SUBTOTALS AT EACH BOLD CELL IN "G"
    If r.Font.Bold = True Then
        With r
            .Formula = "=sum(r" & s & "c:r" & r.Row - 1 & "c)"
            .Interior.ColorIndex = 36
        End With

Any assistance greatly appreciated.

 

[Jon von der Heyden]

Assuming I understand the question, and given your last sheet sample:

Public Sub Waaaaaaaa()
    Dim rngVals As Range
    Dim rngCell As Range
    
    Set rngVals = Range("G14:G26")
    
    For Each rngCell In rngVals.SpecialCells(xlCellTypeBlanks)
        With rngCell(2)
            If Len(.Value) And Not .HasFormula Then
                rngCell.Formula = "=SUM(" & Intersect(.Resize(.Parent.Rows.Count - .Row), .CurrentRegion).Address & ")"
            End If
        End With
    Next rngCell
End Sub

 

[Michael M]

Nope, sorry Jon / Robert....I'm obviously not explaining this right.
Lets forget my original code and start afresh
ALL of the cells are imported in as TEXT.
I need to replace the BOLD text Subtotal with a formula that SUMS from 1 row below the BOLD text down as far as 1 row above the next BOLD text....then do the same thing down the column.. This applies to COLUMN "G" ONLY
So in my example.
G14 is TEXT not a calculation, but it needs to be replaced WITH a calculation
Therefore in G14 the formula will be "=SUM(G15:G19)"
G20 will be "=SUM(G21:G22)"
G23 will be "=SUM(G24:G26)"

HTH

<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>D</th><th>E</th><th>F</th><th>G</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">14</td><td style="font-weight: bold;text-align: right;;">1</td><td style="font-weight: bold;text-align: center;;">Item</td><td style="font-weight: bold;text-align: right;;"></td><td style="font-weight: bold;text-align: right;;"> $ 26,250.00 </td></tr><tr ><td style="color: #161120;text-align: center;">15</td><td style="text-align: right;;">30.0</td><td style="text-align: center;;">hour</td><td style="text-align: right;color: #FF0000;;">50.00</td><td style="text-align: right;border-right: 1px solid black;;">1,500.00</td></tr><tr ><td style="color: #161120;text-align: center;">16</td><td style="text-align: right;;">3.0</td><td style="text-align: center;;">each</td><td style="text-align: right;color: #FF0000;;">7500.00</td><td style="text-align: right;border-right: 1px solid black;;">22,500.00</td></tr><tr ><td style="color: #161120;text-align: center;">17</td><td style="text-align: right;;">5.0</td><td style="text-align: center;;">m3</td><td style="text-align: right;color: #FF0000;;">250.00</td><td style="text-align: right;border-right: 1px solid black;;">1,250.00</td></tr><tr ><td style="color: #161120;text-align: center;">18</td><td style="text-align: right;;">1.0</td><td style="text-align: center;;">item</td><td style="text-align: right;color: #FF0000;;">1000.00</td><td style="text-align: right;border-right: 1px solid black;;">1,000.00</td></tr><tr ><td style="color: #161120;text-align: center;">19</td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style=";"></td><td style="text-align: right;border-right: 1px solid black;;"></td></tr><tr ><td style="color: #161120;text-align: center;">20</td><td style="font-weight: bold;text-align: right;;">1930</td><td style="font-weight: bold;text-align: center;;">m2</td><td style="font-weight: bold;text-align: right;;"></td><td style="font-weight: bold;text-align: right;;"> $ 148,610.00 </td></tr><tr ><td style="color: #161120;text-align: center;">21</td><td style="text-align: right;;">1930.0</td><td style="text-align: center;;">m2</td><td style="text-align: right;color: #FF0000;;">77.00</td><td style="text-align: right;border-right: 1px solid black;;">148,610.00</td></tr><tr ><td style="color: #161120;text-align: center;">22</td><td style="text-align: right;;"></td><td style="text-align: center;;"></td><td style="text-align: right;color: #FF0000;;"></td><td style="text-align: right;border-right: 1px solid black;;"></td></tr><tr ><td style="color: #161120;text-align: center;">23</td><td style="font-weight: bold;text-align: right;;">1</td><td style="font-weight: bold;text-align: center;;">Item</td><td style="font-weight: bold;text-align: right;;"></td><td style="font-weight: bold;text-align: right;;"> $ 4,500.00 </td></tr><tr ><td style="color: #161120;text-align: center;">24</td><td style="text-align: right;;">80.0</td><td style="text-align: center;;">hour</td><td style="text-align: right;color: #FF0000;;">50.00</td><td style="text-align: right;border-right: 1px solid black;;">4,000.00</td></tr><tr ><td style="color: #161120;text-align: center;">25</td><td style="text-align: right;;">2.0</td><td style="text-align: center;;">day</td><td style="text-align: right;color: #FF0000;;">125.00</td><td style="text-align: right;border-right: 1px solid black;;">250.00</td></tr><tr ><td style="color: #161120;text-align: center;">26</td><td style="text-align: right;;">2.0</td><td style="text-align: center;;">day</td><td style="text-align: right;color: #FF0000;;">125.00</td><td style="text-align: right;border-right: 1px solid black;;">250.00</td></tr></tbody></table><p style="width:7.2em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Price Makeup</p><br /><br />

I'm about to open the Merlot......Aaargh !!!

 

[Jon von der Heyden]

Public Sub Waaaaaaaa()
    Dim rngVals As Range
    Dim rngCell As Range
    
    Set rngVals = Range("G14:G26")
    
    For Each rngCell In rngVals
        With rngCell
            If .Font.Bold Then
                .Formula = "=SUM(" & Intersect(.Offset(1).Resize(.Parent.Rows.Count - .Row), .CurrentRegion).Address & ")"
            End If
        End With
    Next rngCell
End Sub

I'm about to open the Merlot......Aaargh !!!

Make mine a scotch :P

 

[Trebor76]

Or maybe this:

Sub SubBold()

    Dim lngRowLast As Long, _
        lngLoopCount As Long
        
    Application.ScreenUpdating = False

    lngRowLast = Worksheets("Price Makeup").Cells(Rows.Count, "G").End(xlUp).Row
    
    With Worksheets("Price Makeup")
    
        For lngLoopCount = 14 To lngRowLast
        
            If .Range("D" & lngLoopCount).Font.Bold = True Or _
               .Range("E" & lngLoopCount).Font.Bold = True Or _
               .Range("F" & lngLoopCount).Font.Bold = True Then
                lngFormulaRow = lngLoopCount
                lngFormulaRowStart = lngLoopCount + 1
            ElseIf Len(.Range("G" & lngLoopCount)) = 0 Then
                With .Range("G" & lngFormulaRow)
                    .Formula = "=SUM(G" & lngFormulaRowStart & ":G" & lngLoopCount - 1 & ")"
                    .Font.Bold = True
                End With
            Else
                With .Range("G" & lngFormulaRow)
                    .Formula = "=SUM(G" & lngFormulaRowStart & ":G" & lngLoopCount & ")"
                    .Font.Bold = True
                End With
            End If
                    
        Next lngLoopCount
        
    End With
    
    Application.ScreenUpdating = True

End Sub

 

[Trebor76]

And if my logic is correct, a small tweak to Jon's really clever colution will do the trick much nicer:

Public Sub Waaaaaaaa()
    
    Dim rngVals As Range
    Dim rngCell As Range
    
    Set rngVals = Range("G14:G26")
    
    For Each rngCell In rngVals
        With rngCell
            If .Offset(0, -3).Font.Bold Or _
               .Offset(0, -2).Font.Bold Or _
               .Offset(0, -1).Font.Bold Then
                .Formula = "=SUM(" & Intersect(.Offset(1).Resize(.Parent.Rows.Count - .Row), .CurrentRegion).Address & ")"
            End If
        End With
    Next rngCell
    
End Sub

I'm about to open the Merlot......Aaargh !!!

I don't drink so it's off for a cuppa!!

 

[Michael M]

Geez, I'm glad I opened the wine !
Jon your code seems to add the rest of the column starting at each BOLD cell

AND
Robert, yours does exactly as required !!!!
Thank you both so much for your input....I can see why I couldn't get my head 'round this.

Now back to the bottle !!
Cheers gentlemen.

 

[Michael M]

No Robert, Jon's solution sums from each bold cell to the bottom of the column, not to the next BOLD line.
So, at this stage your original code is in.

 

[Jon von der Heyden]

Jon your code seems to add the rest of the column starting at each BOLD cell

I get that.... So those aren't proper blank cells between then.

 

[Michael M]

Just did a quick check to make sure....they are definitely blank cells !!
=Len(G23)....returns zero

 

[Trebor76]

No Robert, Jon's solution sums from each bold cell to the bottom of the column, not to the next BOLD line.

After my tweak the formula results were the same as were their cell placement. Jon's method is statically set to end at Row 26 which can easily be adjusted to be dynamic.