VB loop

Hello, I have the macros below. What the macro does is it looks for the word "insert", then deletes it, then it inserts a cell. This macro is useful, but once all the words have been found and deleted, the macro gives me a run-time error. What I want to know is if there is a way for me to tell the macro to stop running once it has found all the words. I am able to count the number of times the word "insert" appears. Maybe there is a way for the VB to tell how many times it should loop by looking at the count number in cell a1?

Thanks for advance.

- thomas

Sub CALC2_SUMMARY71_TO_INSERT_ROW()

Application.Goto Reference:="R1C21"
ActiveCell.Offset(489, 0).Range("A1").Select
Application.Goto Reference:="R1C21"
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Find(What:="INSERT", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True).Activate
ActiveCell.Select
Application.CutCopyMode = False
Selection.Cut
Application.CutCopyMode = False
Selection.ClearContents
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Interior.ColorIndex = 45
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.Insert Shift:=xlDown
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.Insert Shift:=xlDown
Application.Goto Reference:="R1C21"
End Sub

Sub CALC2_SUMMARY72_TO_INSERT_ROW()

Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
Application.Run "CALC2_SUMMARY71_TO_INSERT_ROW"
End Sub