Macro Multiple Data Sets in 1 sheet Varying Column Length Sum Function

[xcelnovice]

Hello,

I'd like to write a macro to sum Column D for each section of this sheet. Below is a sample but in my actual sheet the data continues on with various number of columns. I'm just learning macros have read how other threads but have trouble applying it to my sheet. So any notes explaining what the code is doing would be greatly appreciated.

[TABLE="width: 192"]
<COLGROUP><COL style="WIDTH: 48pt" span=4 width=64><TBODY>[TR]
[TD="width: 64, bgcolor: transparent"][/TD]
[TD="width: 64, bgcolor: transparent"][/TD]
[TD="width: 64, bgcolor: transparent"][/TD]
[TD="width: 64, bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Bread[/TD]
[TD="bgcolor: transparent"]White[/TD]
[TD="bgcolor: transparent"]Type 1[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]13.01%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 2[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]22.49%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 3[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]10.44%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 4[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]33.09%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 5[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]0.32%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 6[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]0.34%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 7[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]10.90%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 8[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]9.41%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Bread[/TD]
[TD="bgcolor: transparent"]Rye[/TD]
[TD="bgcolor: transparent"]Type 1[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]39.98%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 2[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]58.84%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 3[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]0.57%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 4[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]0.61%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Bread[/TD]
[TD="bgcolor: transparent"]Wheat[/TD]
[TD="bgcolor: transparent"]Type 1[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]55.49%[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"]Type 2[/TD]
[TD="class: xl63, bgcolor: transparent, align: right"]44.51%[/TD]
[/TR]
</TBODY>[/TABLE]

 

[ParamRay]

.
.

Doesn't each group add up to 100% ?..

 

[xcelnovice]

Yes but not always

 

[ParamRay]

.
.

Assuming there's an empty row separating each group of percentages (as in your sample), then you could try something like this:

Sub SumAreas()

    Dim SRang As Range
    Dim SArea As Range
    
    On Error Resume Next
        With ActiveSheet.Columns("D")
            Set SRang = Union( _
                .SpecialCells(xlCellTypeConstants, xlNumbers), _
                .SpecialCells(xlCellTypeFormulas, xlNumbers))
        End With
    On Error GoTo 0
    
    If Not SRang Is Nothing Then
        For Each SArea In SRang.Areas
            With SArea.Offset(0, 1).Item(1)
                .Value = WorksheetFunction.Sum(SArea)
                .NumberFormat = "0.00%"
            End With
        Next SArea
    End If

End Sub