individual subtotals

This routine may help you out.
Just call it after you have run your initial routine.

Ivan

Sub Sub_Totals()
Dim LRow As Integer
Dim SubTtlCells As Double
Dim DataCellCount As Double
Dim SubTtl As Double

Const st = " SubTotal"
SubTtlCells = 1
DataCellCount = 1

'Get last row of data
LRow = Range("A65536").End(xlUp).Row

Do While DataCellCount < LRow
Do Until Cells(SubTtlCells, 1) = ""
SubTtl = SubTtl + Cells(SubTtlCells, 1)
SubTtlCells = SubTtlCells + 1
DataCellCount = DataCellCount + 1
Loop
Cells(SubTtlCells, 1) = SubTtl
Cells(SubTtlCells, 2) = st
SubTtl = 0
SubTtlCells = SubTtlCells + 1: DataCellCount = DataCellCount + 1
Loop
End Sub

dear Ivan
thank you very much for your help and for replying so quickly.
one question though, will the value of the subtaotal before affect the value of the next subtotal? however if it does not then it is exactly what I need. i just need it to give values of each corrosponding column.
PLease can you answer this.

thanks again for your help
look forward to hearing from you soon

: i have written a macro that sorts data and inserts a row between each different section of data I need a subtotal of each subsection can anyone help? : example of what I need : data : _________________subtotal : data1 : data1 : data1 : _________________subtotal : data2 : data2 : data2 : data2 : data2 : data2 : _________________subtotal

Andrew
Yes it does.....BUT if unsure then try it on
some backup data....always pays to test it anyway.

Ivan

dear Ivan thank you very much for your help and for replying so quickly. one question though, will the value of the subtaotal before affect the value of the next subtotal? however if it does not then it is exactly what I need. i just need it to give values of each corrosponding column. PLease can you answer this. look forward to hearing from you soon : Just call it after you have run your initial routine. : Dim LRow As Integer : Dim SubTtlCells As Double : Dim DataCellCount As Double : Dim SubTtl As Double : SubTtlCells = 1 : DataCellCount = 1 : LRow = Range("A65536").End(xlUp).Row : Do Until Cells(SubTtlCells, 1) = "" : SubTtl = SubTtl + Cells(SubTtlCells, 1) : SubTtlCells = SubTtlCells + 1 : DataCellCount = DataCellCount + 1 : Loop : Cells(SubTtlCells, 1) = SubTtl : Cells(SubTtlCells, 2) = st : SubTtl = 0 : SubTtlCells = SubTtlCells + 1: DataCellCount = DataCellCount + 1 : Loop : End Sub :