Try this code

Sub MakeSubtotal()

LastRow = Range("L" & Rows.Count).End(xlUp).Row
Rows("1:" & LastRow).Sort _
header:=xlYes, _
key1:=Range("L1"), _
order1:=xlAscending

RowCount = 2
StartRow = RowCount
Do While Range("L" & RowCount) < ""
'see if data in column L doesn't match next row
If Range("L" & RowCount) < _
Range("L" & (RowCount + 1)) Then

'insert new row
Rows(RowCount + 1).Insert
'put total in new row in column Q
Range("Q" & (RowCount + 1)) = "Total"
'put formula in column R to get total
Range("R" & (RowCount + 1)).Formula = _
"=Sum(R" & StartRow & ":R" & RowCount & ")"
'make the row bold
Rows(RowCount + 1).Font.Bold = True

'add 4 more rows
Rows((RowCount + 2) & ":" & (RowCount + 4)).Insert
RowCount = RowCount + 5
StartRow = RowCount


Else
RowCount = RowCount + 1
End If
Loop

End Sub


"David" wrote:

Hi All,

I want to develop a macro which can sort Asen my data based on column L,
subtotal based on column L, and total cloumn R and type total on column Q,
bold the total line and insert 4 lines and do the same for the rest of the
data.

the data range will change everytime i run the macro.

thanks