Maybe:
Sub joshurobbins()
Dim lastrow As Long
Dim x As Long, i As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).row
Application.ScreenUpdating = False
For x = lastrow To 2 Step -1
If Cells(x, 1).Value <> Cells(x - 1, 1).Value Then
If Cells(x, 1).Value <> "" Then
If Cells(x - 1, 1).Value <> "" Then
Cells(x, 1).EntireRow.Insert Shift:=xlDown
End If
End If
End If
Next x
For i = 11 To 12
For Each numrange In Columns(i).SpecialCells(xlConstants, xlNumbers).Areas
sumaddr = numrange.Address(False, False)
numrange.Offset(numrange.Count, 0).Resize(1, 1).Formula = "=SUM(" & sumaddr & ")"
Cells(numrange.Cells(1, 1).row, "P") = Cells(numrange.Cells(1, 1).row, "P") + numrange.Offset(numrange.Count, 0).Resize(1, 1).Value
numrange.Offset(numrange.Count, 0).Resize(1, 1).Clear
c = numrange.Count
Next numrange
Next i
Application.ScreenUpdating = True
End Sub
Bookmarks