Macro won't stop running!

I have a macro that formats data for me. I've attached a spreadsheet with it in and the data it formats but for some reason it just keeps on running and won't stop once finished. I have to hit ESC twice to get out of it.

Here is the macro:

PHP Code: 

Sub D_VO_Prep()
'
' Data_Prep Macro
' Macro recorded 24/04/2007 by Lee
'
    Columns("A:A").Select
    Selection.Copy
    Columns("B:B").Select
    ActiveSheet.Paste
    Selection.Replace What:="* ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("A:A").Select
    Selection.Replace What:=" *", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.NumberFormat = "0.00"
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("D:J").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:C600").Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range _
        ("A1"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase _
        :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
        Columns("A:C").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    With Range("B1:B600")
        Do
            Set rngFind = .Find(What:="run", After:=.Cells(1, 1), LookIn:=xlFormulas, _
                                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=False, SearchFormat:=False)
            
            If rngFind Is Nothing Then Exit Do
                
            rngFind.EntireRow.Delete
        Loop
    End With
    
    With Range("B1:B600")
        Do
            Set rngFind = .Find(What:="", After:=.Cells(1, 1), LookIn:=xlFormulas, _
                                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=False, SearchFormat:=False)
            
            If rngFind Is Nothing Then Exit Do
                
            rngFind.EntireRow.Delete
        Loop
    End With
    Columns("A:A").Select
    Selection.Insert Shift:=xlRight
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Runners"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Track"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Time"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Horse"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Rating"
    Range("E2").Select
    
        Range("F2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=PROPER(RC[-4])"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F350"), Type:=xlFillDefault
    Range("F2:F350").Select
    ActiveWindow.ScrollRow = 1
    Selection.Copy
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=PROPER(RC[-2])"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F350"), Type:=xlFillDefault
    Range("F2:F350").Select
    ActiveWindow.ScrollRow = 1
    Selection.Copy
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("F:F").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    
    
Dim lRow As Long
  Dim lLastTime As Double
  Dim iTimeCount, iLoopCounter As Integer
    
  lLastTime = Cells(2, 3)
  iTimeCount = 1
  
  For lRow = 3 To 350
    If Cells(lRow, 3) <> lLastTime Then
      For iLoopCounter = iTimeCount To 2
        Rows(lRow).Insert Shift:=xlDown
        Cells(lRow, 3) = Cells(lRow - 1, 3)
        lRow = lRow + 1
      Next iLoopCounter
      lLastTime = Cells(lRow, 3)
      iTimeCount = 1
    Else
      iTimeCount = iTimeCount + 1
      If iTimeCount > 3 Then
        Rows(lRow).Delete Shift:=xlUp
        lRow = lRow - 1
      End If
    End If
  Next lRow
End Sub 


The problem is with the last part of the macro where it starts "Dim lRow As Long" and I have put the line "For lRow = 3 To 350" in the macro which I thought should make it stop running that part at row 350 but it seems to want to carry on for infinity!

Can anyone point out my error?