Sub ABC()
Dim lastrow As Long, ar As Range
Dim cell As Range, i As Long
Dim rng As Range
lastrow = Cells(Rows.Count, 1).End(xlUp).Row

For i = lastrow To 1 Step -1
If Cells(i, 1) < Cells(i + 1, 1) Then
Rows(i + 1).Insert
End If
Next
Set rng = Columns(2).SpecialCells(xlConstants, xlNumbers)
For Each ar In rng.Areas
Set cell = ar(ar.Count).Offset(0, 2)
cell.Value = Application.Sum(ar)
Set cell = cell.Offset(0, 1)
cell.Value = Application.Sum(ar.Offset(0, 1))
Next
End Sub

This assumes your numbers are numeric constants - not produced by formulas
or numbers that are stored as text strings.

--
Regards,
Tom Ogilvy



"Darren via OfficeKB.com" wrote:

Hi!


I have 3 collums of data

B C

1 45 200
1 50 333
2 60 500
2 10 500
2 80 90
3 90 30
3 800 20
4 80 10
5 250 5
6 300 3
6 60 80

I would like to run a loop which subtotalled my data twice based upon the
first
collumn (as below)

B C B Sub Totals C Sub Totals


1 45 200
1 50 333 95
533
2 60 500
2 10 500
2 80 90 150
1090
3 90 30
3 800 20 890
50
4 80 10 80
10
5 250 5 250
5
6 300 3
6 60 80 360
83

Thanks in advance

Darren

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200603/1