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?

Hi Mudraker,

Thanks for the ammendment.
Unfortunately it didn't work it gives a completely different result.

The result is in a workbook in the attached spreadsheet.

It should show exactly 3 entries for each time!

I'm lost on this one so any help would be greatly appreciated.

Hi Roy,

I have no idea what you mean.
Can you explain or show me where the error is and how to fix it!?!?

I'm a bit of a novice with macros but the error is definately where I have pointed out.

Hi,

Thanks for the tips.
I've tried your new macro but the last section of the code still keeps on running and running.

I need to know how to make it stop!