Copy Paste Macro is ultra slow | Optimization needed

Question

Below is my VBA code which is ultra slow (takes around 3 minutes to copy and paste three new rows!). The database itself contains around 10,000 rows and I am not sure whether that is causing that slow performance or whether the code itself is far away from being efficient. It certainly has nothing to do with the hardware rig.

Sub AutomateUserResearch()

Dim rowlast As Long 'letzte benutze Zeile
Dim rowlastexport As Long 'letzte benutze Zeile auf "database" + 1 addieren
Dim rowlastexportfinal As Long 'letzte benutze Zeile auf "database" nach Hinzufügen neuer Zeilen finden
Dim NewRecords As String
Dim i As Integer

Application.ScreenUpdating = False

Calculate
NewRecords = ThisWorkbook.Worksheets("checklist").Range("NewRecordsCheck").Value

With Sheets("csv_import")
    rowlast = .UsedRange.Rows.Count + .UsedRange.Row - 1 'find last used row on "csv_import"

    .Range(.Cells(2, 1), .Cells(rowlast, 1)).Formula = .Cells(2, 1).Formula 'copy down formulas for column A
'    .Range(.Cells(2, 1), .Cells(rowlast, 1)).Select
'        With Selection
'            .Interior.ThemeColor = xlThemeColorAccent4
'        End With
    .Range(.Cells(2, 2), .Cells(rowlast, 2)).Formula = .Cells(2, 2).Formula 'copy down formulas for column B
End With

Sheets("csv_import").Calculate

With Sheets("csv_import")
    rowlast = .UsedRange.Rows.Count + .UsedRange.Row - 1
End With

With Sheets("database")
    rowlastexport = .UsedRange.Rows.Count + 1 + .UsedRange.Row - 1
End With

ActiveWorkbook.Worksheets("csv_import").Activate

If NewRecords = "YES" Then 'only proceed with Sub if Column A on "csv_import" has rows with "new" in it, otherwise Exit Sub as no new records exist
    'MsgBox ("New Records Exist")
    ActiveSheet.Range("A1:S1").AutoFilter Field:=1, Criteria1:="new"
    ActiveSheet.Range("B2 : D" & rowlast).Copy
    Sheets("database").Range("A" & rowlastexport).PasteSpecial
    Sheets("csv_import").Range("A1:S1").AutoFilter Field:=1
    Sheets("csv_import").Calculate
    Sheets("checklist").Calculate
Else:
    MsgBox ("There are no new records to be exported!")
    Exit Sub
End If

With ActiveWorkbook.Worksheets("database")
    rowlastexportfinal = .UsedRange.Rows.Count + 1 + .UsedRange.Row - 1
    For i = 4 To 19 'iterate through column 4 to 19 to copy down formulas and add color
       .Range(.Cells(2, i), .Cells(rowlastexportfinal, i)).Formula = .Cells(2, i).Formula
       .Range(.Cells(2, i), .Cells(rowlastexportfinal, i)).Interior.ColorIndex = 15
    Next i
End With

Sheets("database").Calculate
Sheets("database").Select
Application.ScreenUpdating = True

End Sub

Can you add some comments to explain what this is doing? Why, for example, do you loop on `i = 4 To 19`? — Patrick Collins, Jun 06 '14 at 20:33
Try some of these: http://stackoverflow.com/questions/23700935/how-to-lessen-loading-or-procesing-time-in-vba/23701283#23701283 — CodeJockey, Jun 06 '14 at 21:18

score 3 · Answer 1 · answered Jun 07 '14 at 05:58

I don't see anything glaringly obvious. A few thoughts:

You might try setting Application.Calculation = xlCalculationManual. That will keep Excel from calculating every time a cell's value changes. If you have a lot of formulas (it seems that you do), calculations can be a real drain on performance.

There may be a reason for the way you did this, but you might also try waiting to force calculations until the end of the code and calculate the entire workbook at once.

Anytime you copy something to the clipboard, it drains performance. If you're only concerned with copying values, you can try the Range("A1").Value = Range("B1").Value method of copying values. This will bypass the clipboard and save you some performance.

If you have any worksheet events, you might try setting Application.EnableEvents = False.

Those are the only things I can think of. Good luck!

Copy Paste Macro is ultra slow | Optimization needed

1 Answers1