VBA speed up

[shawntweber]

I've got some VBA Subs I use to frequently fix millions of rows of excel data. They all work very well and are very fast and the same speed to the naked eye. However, one of the Subs (badSub) processes MUCH slower than the others. How can I change "badSub" to be as fast as the "GoodSubs". I'm not interested in code like that I could apply to all the Subs like:

Application.Calculation = xlManual
Application.ScreenUpdating = False

I'm interested in what part of the "badSub" code is causing it to behave much slower than the others.


Sub goodSubOne()
Dim foundRange As Range

Set foundRange = Columns("A").Find("Feb/26/2013")

Do While Not foundRange Is Nothing
foundRange.Range("A1:A7").Select
Selection.EntireRow.Delete
Set foundRange = Columns("A").Find("Feb/26/2013")
Loop
End Sub



Sub goodSubTwo()
Dim foundRange As Range

Set foundRange = Cells.Find("f report")

Do While Not foundRange Is Nothing
foundRange.Range("A1:A5").Offset(-4, 0).Select
Selection.EntireRow.Delete
Set foundRange = Cells.Find("f report")
Loop
End Sub



Public Sub goodSubThree()
Dim foundRange As Range
Dim firstRange As String

Set foundRange = Columns("G").Find(what:="*", LookIn:=xlFormulas)

If Not foundRange Is Nothing Then
firstRange = foundRange.Address
Do
Range(foundRange.Offset(1, 1), foundRange.End(xlDown).Offset(-1, 1)).Select
Selection.Cut Destination:=Selection.Offset(-1, 0)
Set foundRange = Columns("G").FindNext(foundRange)
Loop While foundRange.Address <> firstRange
End If
End Sub



Sub badSub()
Dim foundRange As Range

Do
Set foundRange = Columns("H").Find(what:="", LookIn:=xlFormulas)
Range(foundRange, foundRange.End(xlDown).Offset(-1, 0)).Select
Selection.EntireRow.Delete
Loop Until Selection.Height > 1000

End Sub