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 ***** 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