Sub Total collumns

[Darren via OfficeKB.com]

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

 

[Tom Ogilvy]

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.

 

[FIRSTROUNDKO via OfficeKB.com]

Tom,

Thats just awesome

Thanks

Darren

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