Excel VBA - Inserted rows appearing at top of selection instead of bottom - vba

Question

I am working with this macro that will look at a block of transactions, insert 3 rows between months, and then add the month and subtotal. The issue is that the break and totals are getting inserted at the beginning of the month instead of the end.
I have tried to adjust the shift but it either ends up giving me an error or the total ends up overriding an existing cell instead of going into a new row. This is a more complex macro than I have worked with before and I'm a little lost now, still working on learning VBA.
Option Explicit
Sub AddAndSum()
On Error GoTo lblError
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim shData As Worksheet, wbData As Workbook
Dim fr As Long, lr As Long, i As Long, lr2 As Long
Dim intMonth As Long, intYear As Long
Set wbData = ThisWorkbook
Set shData = wbData.Sheets("Sheet1")
fr = 13
lr = shData.Rows.Count
For i = fr To lr
With shData
If (IsDate(.Cells(i, 3).Value) And IsDate(.Cells(i - 1, 3).Value) And Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value)) Or i = fr Then
intMonth = Month(.Cells(i, 3).Value)
intYear = Year(.Cells(i, 3).Value)
.Rows(i & ":" & i + 2).Insert Shift:=xlDown
.Cells(i + 1, 1).Value = "Monthly Total (" & MonthName(intMonth) & ")"
.Cells(i + 1, 2).Formula = "=SUMPRODUCT((MONTH($C$" & fr & ":$C$" & lr & ")=" & intMonth & ")*(YEAR($C$" & fr & ":$C$" & lr & ")=" & intYear & ")*$E$" & fr & ":$E$" & lr & ")"
i = i + 3
End If
End With
Next i
lblError:
If Err.Number <> 0 Then
MsgBox "Error (" & Err.Number & "): " & Err.Description, vbOKOnly + vbCritical
End If
GoTo lblExit
lblExit:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculate
Application.Calculation = xlCalculationAutomatic
Exit Sub
End Sub

Answer 1

This line begins the insertion at Row i.
.Rows(i & ":" & i + 2).Insert Shift:=xlDown
You want to begin the insertion at row i+3, and you can accomplish that with the Offset method:
.Rows(i & ":" & i + 2).Offset(3).Insert Shift:=xlDown
You may also want to see this answer regarding best way of getting the "last row" in a column:
Error in finding last used cell in VBA
As you're currently doing lr = shData.Rows.Count that is 65,336 rows in Excel 2003, or 1,048,576 rows in Excel 2007+ and you almost certainly do not have that many data (otherwise an Insert would fail!), so your loop is cycling needlessly over a bunch of empty rows.

Answer 2

You need to change this row:
intMonth = Month(.Cells(i, 3).Value)
to
intMonth = Month(.Cells(i-1, 3).Value)
At the moment it is setting intMonth to the value of the current cell (which is the first cell of the next month) instead of the value of the previous cell (which contains the month you want to subtotal).
Then add a condition into your loop to add the last subtotal.
Also:
If (IsDate(.Cells(i, 3).Value) And IsDate(.Cells(i - 1, 3).Value) And Month(.Cells(i, 3).Value) <> Month(.Cells(i - 1, 3).Value)) Or i = fr Then
Should this be i = lr ? as you are checking for the last line in the sheet? At the moment will always put a subtotal after the first line. You'll need to update this value when you add the three subtotal lines in as well.