How to remove a row in Excel based on cell value?

Question

I have an Excel and I want delete some rows based on the particular cell value, but the Excel is very very huge it has got around 75000 rows. I tried writing a normal function to loop through the sheet, check for the cell value and delete the rows if matched, but it is taking very long time. I waited for 30 min and program was still running can some one suggest me how to achieve this.

Following is the code.

Private Sub CommandButton1_Click()
    Dim i As Integer

        For i = Range("D1").End(xlDown).Row To 1 Step -1
                If Cells(i, 4) = 7 Then
                    Rows(i).Delete Shift:=xlUp
                End If
        Next i
End Sub

I tested this code for small Excel file with 50 rows and it is working fine. But when I try on the excel I wanted to try it kept me waiting for 30 min and could not complete.

Answer 1

If you want to delete rows in which column D has the value 7 and there are no blanks in column D, then run:

Sub Tachyon()
    Dim rD As Range
    Set rD = Intersect(Range("D:D"), ActiveSheet.UsedRange)
    rD.Replace "7", ""
    rD.Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

EDIT1 :

DO NOT USE THIS MACRO

Testing indicates that not only does it remove rows containing 7 in column D, it also removes rows whose cells containing 77 or 777. It also corrupts values like 17 or 71. We need something better.

EDIT2

This version has the problem fixed:

Sub Tachyon2()
    Dim rD As Range
    Set rD = Intersect(Range("D:D"), ActiveSheet.UsedRange)
    rD.Replace What:="7", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    rD.Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub