I fully test this code so it should work if there is at least some data
starting in row 4.

Sub Makesubtotals()
LastRow = Range("C" & Rows.Count).End(xlUp).Row
Rows("4:" & LastRow).Sort _
header:=xlNo, _
key1:=Range("C4"), _
order1:=xlAscending

RowCount = 4
StartRow = RowCount 'first row of the addion for each product code
Do While Range("C" & RowCount) < ""
If Range("C" & RowCount) < _
Range("C" & (RowCount + 1)) Then
'insert new row
Rows(RowCount + 1).Insert
'make a formula to add the column
Range("N" & (RowCount + 1)).Formula = _
"=Sum(F" & StartRow & ":F" & RowCount & ")"
Range("O" & (RowCount + 1)).Formula = _
"=Sum(K" & StartRow & ":K" & RowCount & ")"
Range("P" & (RowCount + 1)).Formula = _
"=O" & (RowCount + 1) & "/N" & (RowCount + 1)

RowCount = RowCount + 2
StartRow = RowCount
Else
RowCount = RowCount + 1
End If
Loop

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=177957

Microsoft Office Help