Excel VBA Macro to Auto Insert row and insert Total and sum

[Jyotirmaya]

I am using the below code to insert total in the rows based on the Serial Number in Row A starting from Row 6, there are more than 5000 rows in a sheet.
But when there are two serial numbers like in this example A15 and A16, the below code doesn't add a new row Total below the A15. it inserted the total in A17 and inserted a blank row in A14. instead of inserting total in A16 and the last total in A17.

Sub InsertTotals()

   Dim Rng As Range
   
   With Range("A7:A" & Range("G" & Rows.Count).End(xlUp).Row)
      .SpecialCells(xlConstants).EntireRow.Insert
   End With
   
   With Range("G6", Range("G" & Rows.Count).End(xlUp))
      For Each Rng In .SpecialCells(xlConstants).Areas
         If Rng.Offset(Rng.Count - 1).Resize(1).Value = "Total" Then Rng.Offset(Rng.Count - 1).Resize(1).EntireRow.Delete
         Rng.Offset(Rng.Count).Resize(1).Value = "Total"
         With Rng.Offset(Rng.Count, 1).Resize(1, 2)
            .Formula = "=sum(" & Rng.Offset(, 1).Address(False, False) & ")"
         End With
      Next Rng
   End With
End Sub

Getting Result like this

I want result like this

Please help me, what to change the code ??

 

[maxpit]

Hi Logit,

I don't know why, but that is how it works for me

Here below starting data:

and this is the result:

See you soon.

P.s.: Read this ...