Optimize Excel VBA Code

Question

I have the following VBA code within excel. It's goal is to remove a row if the given text is found, as well as remove the row directly below it. It needs to scan roughly 700k rows and is taking roughly an hour to do 100k rows. Does anyone see any optimization?

Sub RemovePageHeaders()
    Application.ScreenUpdating = False
    Dim objRange As Range
    Set objRange = Cells.Find("HeaderText")
    While objRange <> ""
        objRange.Offset(1, 0).Rows(1).EntireRow.Delete
        objRange.Rows(1).EntireRow.Delete
        Set objRange = Cells.Find("HeaderText")
    Wend
    MsgBox ("I'm done removing page headers!")
End Sub

Thanks in advance!

Answer 1

Try the following sub. It loops from the bottomm-most row to the top, checking column 3 for "HeaderText". If that's found, it delete the row and the one below it. On a C2D E8500 with 2 gigs of RAM it takes just over a minute per 100,000 rows on a sheet with 1 million rows.

Sub RemoveHeaders()
    Dim i As Long

    Application.ScreenUpdating = False
    Debug.Print "Started: " & Now
    For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        If ActiveSheet.Cells(i, 3) = "HeaderText" Then
            ActiveSheet.Range(i & ":" & i + 1).EntireRow.Delete
        End If
    Next i
    Application.ScreenUpdating = True
    Debug.Print "Finished: " & Now
End Sub

EDIT For a slightly ghetto but possibly much faster solution try this:

1. Change the constant in the below code to the number of the first column that's blank in every row. For example if your data takes up columns A-F, you want the constant to be 7 (column G).
2. Run the code, it will put the row number next to every entry. Should take around 30 seconds.
3. Sort the ENTIRE data by column C; this should take less than a minute.
4. Find "HeaderText" visually, select and delete all the rows.
5. Sort by your row-numbered column ("G" in my example).

6. Delete the row-numbered column (again, "G" in my example).

   Sub NumberColumns()
       Const BLANK_COLUMN = 7
       Dim i As Long
   
       For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
           ActiveSheet.Cells(i, BLANK_COLUMN) = i
       Next i
       Debug.Print "done"
   

   End Sub

Answer 2

Even if it doesn't fully answer the question, it may help any reader so...

There are several tips on the web about optimizing vba. In particular, you can do:

'turn off some Excel functionality so your code runs faster
'these two are especially very efficient
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'use these if you really need to
Application.DisplayStatusBar = False
Application.EnableEvents = False   'is very efficient if you have ANY event associated with what your macro is going to do

'code goes here

'at the end, don't forget to restore the default behavior
'calculate the formulas
Application.Calculate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True

See here for more information