The below macro will not stop at the end

[Steved]

Hello from Steved

How do I please put a argument in the below macroso that
when it gets to the bottom off the documentit ends as at
the moment when it reaches the end it starts deleting
everything above.

Thankyou.

Sub RaceDictionary()
Dim i As Long, pararange As Range
For i = 1 To ActiveDocument.Paragraphs.Count
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "'"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^$^$^$"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^$^$^$"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=3,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "\(*by"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=3,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.TypeBackspace
Selection.TypeText Text:="= "
Selection.EndKey Unit:=wdLine
Selection.TypeBackspace
Selection.TypeText Text:=", "
Selection.Find.ClearFormatting
With Selection.Find
.Text = "*$"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1,
Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 30
.Bold = True
End With
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Next i
End Sub