Optimizing Copy and paste

Question

I'm trying to run through a large dataset of over 80,000 rows. Copying an entire row if column C contains any text, starting from row 6. Below is my Macro i currently have, is there any way in optimizing it so that it doesn't take so long? the current code runs through row by row.

Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long
endRow = 100000
pasteRowIndex = 1
For r = 6 To endRow 'Loop through Stocks to Sell and search for your criteria

If Cells(r, Columns("C").Column).Value <> Empty Then
        'Copy the current row
             Rows(r).Select
             Selection.Copy
        'Switch to the sheet where you want to paste it & paste
             Sheets("Stocks to Sell").Select
             ActiveSheet.Rows(pasteRowIndex).Select
             Selection.PasteSpecial Paste:=xlPasteValues
        'Next time you find a match, it will be pasted in a new row
             pasteRowIndex = pasteRowIndex + 1
        'Switch back to your table & continue to search for your criteria
             Sheets("Unrealized Gains Report").Select
End If
If Cells(r, Columns("D").Column).Value = "yes" Then 'Found
        'Copy the current row
             Rows(r).Select
             Selection.Copy
        'Switch to the sheet where you want to paste it & paste
             Sheets("Gmma Positions").Select
             ActiveSheet.Rows(pasteRowIndex).Select
             Selection.PasteSpecial Paste:=xlPasteValues
        'Next time you find a match, it will be pasted in a new row
             pasteRowIndex = pasteRowIndex + 1
        'Switch back to your table & continue to search for your criteria
             Sheets("Unrealized Gains Report").Select
End If
Next r
End Sub

I'm new to VBA, so the code is a little basic. Any help would be appreciated

Answer 1

Two major improvements you can make:

1). Disable calculations, screen updating, and alerts at the beginning of your procedure. Then re-enable them at the end.

2). Get out of the habit of Activating and Selecting everything. It's completely unnecessary in most instances and dramatically slows operations.

Try like this, instead (additional notes/explanations in code comments):

Sub testIt()

    ' Disable visual and calc functions
    ' So Excel isn't updating the display and
    ' recalculating formulas every time you
    ' fill another cell
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual



    Dim r As Long
    Dim endRow As Long
    endRow = 100000

    ' I think you actually need separate pastRowIndexes for each target sheet
    Dim pasteRowIndexGmma As Long
    pasteRowIndexGmma = 1

    Dim pasteRowIndexStocks As Long
    pasteRowIndexStocks = 1

    ' Create & set variables for referencing worksheets
    ' These will be used instead of Activating and Selecting the
    ' source and target worksheets, which should speed up operation
    Dim wsStocks As Worksheet
    Set wsStocks = ThisWorkbook.Worksheets("Stocks to Sell")
    Dim wsUnrealized As Worksheet
    Set wsUnrealized = ThisWorkbook.Worksheets("Unrealized Gains Report")
    Dim wsGmma As Worksheet
    Set wsGmma = ThisWorkbook.Worksheets("Gmma Positions")

    For r = 6 To endRow 'Loop through Stocks to Sell and search for your criteria

        If wsUnrealized.Cells(r, Columns("C").Column).Value <> Empty Then

            ' You do not need to keep activating and selecting everything
            ' Just use the worksheet variables to target the correct sheet
            ' No selections necessary

            'Copy the current row
            wsUnrealized.Rows(r).Copy

            'Switch to the sheet where you want to paste it & paste
            wsStocks.Rows(pasteRowIndexStocks).PasteSpecial Paste:=xlPasteValues

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndexStocks = pasteRowIndexStocks + 1

        End If
        If wsUnrealized.Cells(r, Columns("D").Column).Value = "yes" Then 'Found
            'Copy the current row
            wsUnrealized.Rows(r).Copy

            'Switch to the sheet where you want to paste it & paste
            wsGmma.Rows(pasteRowIndexGmma).PasteSpecial Paste:=xlPasteValues

            'Next time you find a match, it will be pasted in a new row
            pasteRowIndexGmma = pasteRowIndexGmma + 1

        End If

    Next r


    ' Re-Enable visual and calc functions
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic


End Sub