Sub DoSums()
Dim sSubTotal As Single
Dim sTotal As Single
Dim ws As Worksheet
Dim iRow As Integer

Set ws = Sheets("Sheet1")
iRow = 10
Do
Do
sSubTotal = sSubTotal + ws.Cells(iRow, 2)
sTotal = sTotal + ws.Cells(iRow, 2)
iRow = iRow + 1
Loop Until ws.Cells(iRow, 1) = ""
ws.Cells(iRow, 2) = sSubTotal
sSubTotal = 0
Loop Until ws.Cells(iRow, 1) = "" And ws.Cells(iRow + 1, 1) = ""
ws.Cells(iRow, 2) = sTotal
End Sub

Hth,
Merjet