CODEWITHSUNDEEP
vbaexcel
Kimber Warden
Kimber Warden

Reputation: 193

Why is my Excel VBA code to copy a cell so slow?

I have 2 worksheets in the same workbook. If a cell in SourceSheet meets certain criteria, I want to copy several non-adjacent cells in the same row to NewSheet. The problem is that it's taking over a half second to paste each and every cell, making the macro far too slow. The code below takes 8 seconds to complete a single loop. Is there a faster way I could do this?

Dim EnrollmentChanges As Range
Dim course1 As Range
Dim course1status As Range
Dim row As Long
Dim lrow As Long
Dim NewSheetRow As Long

'This is a dynamic named range
Set EnrollmentChanges = Sheets("SourceSheet").Range("Source")
NewSheetRow = 0
lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row

For row = 2 To lrow

With EnrollmentChanges

    course1 = Sheets("SourceSheet").Range("A" & row)

    If course1 <> "" Then
        course1status = Sheets("SourceSheet").Range("BS" & row)
        If InStr(1, course1, "APEX") And course1status = "1" Then
            NewSheetRow = NewSheetRow + 1
            Sheets("NewSheet").Range("A" & NewSheetRow) = NewSheetRow
            Sheets("NewSheet").Range("B" & NewSheetRow) = "W"
            Sheets("NewSheet").Range("C" & NewSheetRow) = "S"
            Sheets("NewSheet").Range("D" & NewSheetRow) = "MySchool"
            Sheets("SourceSheet").Range("B" & row).Copy Sheets("NewSheet").Range("G" & NewSheetRow)
            Sheets("SourceSheet").Range("W" & row).Copy Sheets("NewSheet").Range("H" & NewSheetRow)
            Sheets("SourceSheet").Range("V" & row).Copy Sheets("NewSheet").Range("J" & NewSheetRow)
            Sheets("SourceSheet").Range("Y" & row).Copy Sheets("NewSheet").Range("K" & NewSheetRow)
            Sheets("NewSheet").Range("L" & NewSheetRow) = "OR"
            Sheets("SourceSheet").Range("B" & row).Copy Sheets("NewSheet").Range("M" & NewSheetRow)
            Sheets("SourceSheet").Range("A" & row).Copy Sheets("NewSheet").Range("P" & NewSheetRow)
        End If

    Else: GoTo NextRow
    End If 
End With
NextRow:
Next

Upvotes: 0

Views: 2995

Answers (2)

Moreno
Moreno

Reputation: 638

call this sub a the top of you macro:

Sub MakeItFaster()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False

End Sub

Upvotes: 1

Brandon Barney
Brandon Barney

Reputation: 2392

The best way to approach this would to be avoiding copy and paste altogether (which are notoriously slow). The only time that copy/paste MAY be worth keeping is when you need to copy formatting. If you just need the values then you can do something like this:

Dim EnrollmentChanges As Range
Dim course1 As Range
Dim course1status As Range
Dim row As Long
Dim lrow As Long
Dim NewSheetRow As Long

'This is a dynamic named range
Set EnrollmentChanges = Sheets("SourceSheet").Range("Source")
NewSheetRow = 0
lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row

For row = 2 To lrow

With EnrollmentChanges

course1 = Sheets("SourceSheet").Range("A" & row)

If course1 <> "" Then
    course1status = Sheets("SourceSheet").Range("BS" & row)
    If InStr(1, course1, "APEX") And course1status = "1" Then
        NewSheetRow = NewSheetRow + 1
        With Sheets("NewSheet")
            .Range("A" & NewSheetRow).Value = NewSheetRow
            .Range("B" & NewSheetRow).Value = "W"
            .Range("C" & NewSheetRow).Value = "S"
            .Range("D" & NewSheetRow).Value = "MySchool"

            .Range("G" & NewSheetRow.Value = Sheets("SourceSheet").Range("B" & row).Value
            .Range("H" & NewSheetRow).Value = Sheets("SourceSheet").Range("W" & row).Value
            .Range("J" & NewSheetRow).Value = Sheets("SourceSheet").Range("V" & row).Value 
            .Range("K" & NewSheetRow).Value = Sheets("SourceSheet").Range("Y" & row).Value 
            .Range("L" & NewSheetRow).Value = "OR"
            .Range("M" & NewSheetRow).Value = Sheets("SourceSheet").Range("B" & row).Value
            .Range("P" & NewSheetRow).Value = Sheets("SourceSheet").Range("A" & row).Value
        End With
    End If

' No need for this since you are skipping the operation using the if block
' GoTo is messy and should be avoided where possible as well.
'Else: GoTo NextRow
End If 
End With
NextRow:
Next

All I did was swap the order and assign the value directly based on the value retrieved versus storing the value retrieved as a copy, and putting it in a new location. Once you practice this a bit it will make much more sense (and it will speed up your code considerably).

As noted at the beginning, if you need formatting kept then that is a bit different.

Also, I didnt bother with optimizing or indenting any of the other elements of your code, but you will want to clean it up with proper indenting and skipping things like "GoTo".

Upvotes: 1

Related Questions