Inserting multiple rows in very large worksheet

Question

I am hoping someone can help me with optimizing the code below. I was wondering if using "Resize" would be of any benefit.

X = 2

Do Until Cells(X, 1) = ""
    Dim vLoop As Long

    If Cells(X, 10) <> Cells((X + 1), 10) Then
        vLoop = 1

        Do While vLoop < 7
            Select Case vLoop
                Case 1
                    Cells(X, 18) = "BASE SALARY"
                Case 2
                    Cells(X, 18) = "NON-PROFIT BASED BONUS"
                Case 3
                    Cells(X, 18) = "OTHER"
                Case 4
                    Cells(X, 18) = "OVERTIME"
                Case 5
                    Cells(X, 18) = "PROFIT BASED BONUS"
                Case 6
                    Cells(X, 18) = "TOTAL"
                    Exit Do
            End Select

            Range(Cells(X, 1), Cells(X, 17)).Select
            Selection.Copy
            Rows(X + 1).Select
            Selection.Insert Shift:=xlDown
            Application.CutCopyMode = False

            vLoop = vLoop + 1
            X = X + 1
        Loop

        X = X + 1
    End If
Loop

score 0 · Answer 1 · answered Nov 15 '19 at 15:20

One improvement would be removing the select use

Range(Cells(X, 1), Cells(X, 17)).Copy
Rows(X + 1).Insert Shift:=xlDown
Application.CutCopyMode = False

You would also disable calculations during the process which will help speed things up.

Application.Calculation = xlCalculationManual

'...code here

Application.Calculate
Application.Calculation = xlCalculationAutomatic

score 0 · Answer 2 · answered Nov 15 '19 at 15:31

How to avoid using Select in Excel VBA is a must read. Copying values is actually quite fast procedure and straight forward procedure. Furthermore, make sure that the worksheet (and the workbook, if you work with more than 1) is always referred, the dots before Rows, Cells and Range make sure to refer to the correct worksheet:

With Worksheets(1)
    .Rows(x).Insert Shift:=xlDown
    .Range(.Cells(x, 1), .Cells(x, 17)) = .Range(.Cells(x + 1, 1), .Cells(x + 1, 17))
End With

Inserting multiple rows in very large worksheet

2 Answers2