Tom,

Thats just awesome

Thanks

Darren

Tom Ogilvy wrote:
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.

Hi!

[quoted text clipped - 42 lines]

Darren

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