Hi Sharon

This should do it:

Dim FirstRow As Long
Dim TargetCol As String
Dim SumCol As String
Dim LastRow As Long
Dim counter As Long
Dim StartSum As Long
Dim EndSum As Long

Sub InsertRow_Total()

FirstRow = 2 'Assume headers in row 1
TargetCol = "A"
SumCol = "C"
counter = FirstRow
LastRow = Cells(Rows.Count, TargetCol).End(xlUp).Row
StartSum = FirstRow

Do
If Cells(counter, TargetCol).Value < Cells(counter + 1,
TargetCol).Value Then
LastRow = LastRow + 1
Rows(counter + 1).Insert
Cells(counter, TargetCol).Resize(1, 2).Copy Cells(counter + 1,
TargetCol)
EndSum = counter
Cells(counter + 1, SumCol).Formula = "=sum(C" & StartSum & ":C" &
EndSum & ")"
Rows(counter + 1).Font.Bold = True
counter = counter + 2
StartSum = counter
Else
counter = counter + 1
End If
Loop Until counter = LastRow
Cells(counter, TargetCol).Resize(1, 2).Copy Cells(counter + 1, TargetCol)
Cells(counter + 1, SumCol).Formula = "=sum(C" & StartSum & ":C" & counter &
")"
Rows(counter + 1).Font.Bold = True
End Sub

Regards,
Per

"Shazza" skrev i meddelelsen
...
It has been a while since I have coded anything and I am hoping someone
can
help me.
I am wanting to do the following in one macro:-

1. Insert a row if value in column A doesn't match the next value
i.e.
Apple
Apple

Orange

2. At the beginning of each category then insert - shift cells down for
Column A and B and bold and total
i.e.
100
Apple Fruit 100
Apple Fruit 200 (should be bold)

if anyone can help if would be greatly appreciated and would end a list of
manual operations done by many individuals.

Cheers Sharon