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

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

score 2 · Answer 1 · edited May 23 '17 at 10:28

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.

score 0 · Answer 2 · answered Aug 05 '16 at 18:29

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.

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

2 Answers2