CODEWITHSUNDEEP
excelperformancevba
MAM
MAM

Reputation: 21

Excel VBA Copy operation inside loop is extremely slow

The following sub has a Copy statement inside its loop that takes over 2 seconds to execute in Excel 2013. So that would be over 40 seconds for 20 iterations. I have tried all the usual optimations , like disabling events and screen updates. Does anyone have the same problem?

Sub TEST_SUB(surface)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Worksheets("Sheet3").Activate
    ActiveSheet.DisplayPageBreaks = False

    Sheets("Sheet3").Range("A4:Z400").ClearContents


y = 4   'y is the row on sheet3 where we want to paste
For x = 4 To 20 'x is the current row from which we want to copy
        ' Decide if to copy based on whether the value in col 10 matches the parameter Surface
        ThisValue = Sheets("Tests_Master").Cells(x, 10).Value
        If ThisValue = surface Or x = 4 Then
            R1 = "A" + CStr(x) + ":K" + CStr(x) 'Range to copy from: row X columns 1-10

            'This next statement taks about 2 seconds to execute ! WHY????
            Sheets("Tests_Master").Range(R1).Copy Destination:=Sheets("sheet3").Range("A" + CStr(y))
            y = y + 1

        End If

Next x
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Upvotes: 2

Views: 1092

Answers (1)

Kellsens
Kellsens

Reputation: 312

I made some modifications, using the tip

Optimize your code by explicitly reducing the number of times data is transferred between Excel and your code. Instead of looping through cells one at a time to get or set a value, get or set the values in the entire range of cells in one line, using a variant containing a two-dimensional array to store values as needed.

from this article I modified your code:

Sub TEST_SUB(surface)
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Worksheets("Sheet3").Activate
    ActiveSheet.DisplayPageBreaks = False

    Sheets("Sheet3").Range("A4:Z400").ClearContents    

    y = 4   'y is the row on sheet3 where we want to paste
    For x = 4 To 20 'x is the current row from which we want to copy
    ' Decide if to copy based on whether the value in col 10 matches the parameter Surface
        ThisValue = Sheets("Tests_Master").Cells(x, 10).value
        If ThisValue = surface Or x = 4 Then
            R1 = "A" + CStr(x) + ":K" + CStr(x) 'Range to copy from: row X columns 1-10

            'Is faster use an array to store a range to copy after
            rangeToCopy = Sheets("Tests_Master").Range(R1)
            Sheets("sheet3").Range("A" + CStr(y) + ":K" + CStr(y)) = rangeToCopy

            'This next statement taks about 2 seconds to execute ! WHY????
            'Sheets("Tests_Master").Range(R1).Copy Destination:=Sheets("sheet3").Range("A" + CStr(y))
            y = y + 1

        End If

    Next x

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

P.S.: Sorry my english

Upvotes: 1

Related Questions