Win XP, Excel 2007 (12.0.6535.5002) SP2

The code is pretty long is why I didnt post it initially. I put
several timers throughout the code and found the section taking the
time.
Here is the code taking a long time. I did not write it.
Range("D2").Select
Do While ActiveCell.Value < Empty
If ActiveCell = caln And ActiveCell.Offset(0, 4) = 1 Then
ActiveCell.Offset(1, 0).Select
sh1ft = sh1ft + 1
ElseIf ActiveCell = caln + 1 And ActiveCell.Offset(0, 4) = 3
Then
ActiveCell.Offset(1, 0).Select
sh3ft = sh3ft + 1
ElseIf ActiveCell = caln And ActiveCell.Offset(0, 4) = 2 Then
ActiveCell.Offset(1, 0).Select
sh2ft = sh2ft + 1
Else
Range(ActiveCell.Offset(0, -3), ActiveCell.Offset(0,
4)).Delete
End If
Loop

I have found that selecting is a bad thing especially when you have to
process many lines. The data the code was having to go thru was around
700 rows long. Here is my new code. It runs pretty good and stays
pretty consistant each time it runs with the same data to process.

ar = 2 'active row
Do While Cells(ar, 4).Value < Empty
If Cells(ar, 4) = caln And Cells(ar, 8) = 1 Then
ar = ar + 1
sh1ft = sh1ft + 1
ElseIf Cells(ar, 4) = caln + 1 And Cells(ar, 8) = 3 Then
ar = ar + 1
sh3ft = sh3ft + 1
ElseIf Cells(ar, 4) = caln And Cells(ar, 8) = 2 Then
ar = ar + 1
sh2ft = sh2ft + 1
Else
Rows(ar).Delete
End If
Loop

The code is basically looking for the date in column 4 to match caln
and the shift to match 1,2,3. When both match it counts up the # of
each shift or if they dont match it deletes the entire row.
I would appreciate any suggestions anyone has on making such a routine
work faster.

Thanks
Scott