To make code work faster

Hi again experts,

I have some code that delete's rows if the data in that row is not between two date's.
What I need to do is make the code work faster. At the moment it seams to be looking at each row then deleteing that row then moving onto the next row. Is there a way of seleting all the rows not within the date range and then deleteing all those rows at once.
There is another sheet that has formulas based on the data in this sheet and that is why it is going slow I think. I have make the formulas in the other sheet as streamlined as posible with help from here already.

Present code:

Sub Del_button()
Dim dt_fr As Date
Dim dt_to As Date
Dim dt As Date

ActiveSheet.Range("C5").Select
 dt_fr = ActiveSheet.Range("I1").Value
 dt_to = ActiveSheet.Range("I2").Value + 1
Do
    dt = ActiveCell.Value
    If dt < dt_fr Or dt > dt_to Then
       ActiveCell.EntireRow.Delete
    Else
       ActiveCell.Offset(1, 0).Select
    End If
Loop Until ActiveCell.Value = ""

ActiveSheet.Range("D5:G" & ActiveSheet.UsedRange.Rows.Count).Clear
ActiveSheet.Range("B5:C" & ActiveSheet.UsedRange.Rows.Count).Sort _
        Key1:=ActiveSheet.Columns("B"), _
        Key2:=ActiveSheet.Columns("C")

 With Sheets("FP Reader")
      .Range("B5:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, _
                                       CopyToRange:=Sheets("Employees - Table 1").Range("C3"), Unique:=True
   End With

    With Sheets("Employees - Table 1")
    If .Range("C3") = .Range("C4") Then
       .Range("C3").Delete
    End If
End With

ActiveSheet.Range("I4").Select
End Sub


Cheers

Rob.