Add Row On Unmatched Condition

I have a summary list of all projects that my employees work on over the course of the month. Its gets sorted by date and project and is a pretty extensive list.

My goal is simple...to search through the list and add a blank row between each project.

I have written this code, that does work, but it takes quite some time to execute and I know there has to be a better way.

Can you guys take a look at it and see if there is more efficient way to do this?


Dim myarray As Variant
Dim cell As Range
Dim mycount As Integer
Dim i As Integer

Set myarray = Worksheets("summary").Range(Range("b2"), Range("B65536").End(xlUp))
Set cell = Range("b2")
mycount = myarray.Count

For i = 0 To mycount
If cell.Offset(i, 0).Value <> cell.Offset(i + 1, 0).Value Then
Range(cell.Offset(i + 1, -1), cell.Offset(i + 1, 3)).Insert shift:=xlDown
i = i + 1
mycount = mycount + 1
End If
Next i