Insert rows when column A data changes then shade and autosum blanks in columns E to I

I currently have a macro which inserts a row whenever the data in column A changes. What I want to add is that it also shades and autosums columns E throught to I as well.

Could somebody please help me with this?

Here is the code that I am using to insert a row when the data in column A changes

Sub InsRowsWhenCellDataChangesColA()
Dim r As Long, mcol As String, i As Long

' find last used cell in Column A
r = Cells(Rows.Count, "A").End(xlUp).Row

' get value of last used cell in column A
mcol = Cells(r, 1).Value

' insert rows by looping from bottom
For i = r To 2 Step -1
If Cells(i, 1).Value <> mcol Then
mcol = Cells(i, 1).Value
Rows(i + 1).Insert
End If
Next i

End Sub


I have attached the sample data before any changes and the preferred output that I would like to achieve.

I tried to use the Macro Recorder and the result was

Sub Macro1()
'
' Macro1 Macro
'

'
Application.Run "PERSONAL.XLSB!InsRowsWhenCellDataChangesColA"
Columns("E:I").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("E4:I4").Select
Selection.FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
Range("E25:I25").Select
Selection.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("E32:I32").Select
Selection.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("E39:I39").Select
Selection.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
Range("E50:I50").Select
Selection.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
Range("E52:I52").Select
Selection.FormulaR1C1 = "=SUM(R[-1]C)"
Range("E54:I54").Select
Selection.FormulaR1C1 = "=SUM(R[-1]C)"
Range("E64:I65").Select
Selection.FormulaR1C1 = "=SUM(R[-9]C:R[-1]C)"
ActiveWindow.SmallScroll Down:=12
Rows("65:65").Select
Selection.Delete Shift:=xlUp
Range("L51").Select
ActiveWindow.SmallScroll Down:=-57
Columns("G:G").Select
Selection.Cut
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
Range("J6").Select
ActiveWindow.SmallScroll Down:=-9
End Sub



Problem is that the data on my sheets are of varying lengths, so this does not work on one of the other sheets.

I would really appreciate it if someone could help as I have many spreadsheets where this would save me a lot of time on a daily basis.