End or alter a loop?

[DJSOUND]

Hi
I have this code below where I am looking for a certain character style, replacing the character two spaces preceding it with a comma (when text in the character style is "abc") and inserting a period immediately following the character style regardless of the text.


I have it working, but when I tried to do a loop it won't end. I've found that my method is probably not the correct one, but I can't figure out how to do it any other way. Is there a way to just tell the program to find an ending point that it will actually find?
Code:

Sub Macro9()
'
' Macro9 Macro
'
Do Until ActiveDocument.Bookmarks("\Sel") = ActiveDocument.Bookmarks("\EndOfDoc")
  Selection.Find.ClearFormatting
  Selection.Find.Style = ActiveDocument.Styles("one_car")
  Selection.Find.Replacement.ClearFormatting
  With Selection.Find
    .Text = "abc"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
   .MatchAllWordForms = False
  End With
  Selection.Find.Execute
  Selection.MoveLeft Unit:=wdCharacter, Count:=2
  Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
  Selection.TypeText Text:=","
  Selection.Find.ClearFormatting
  Selection.Find.Style = ActiveDocument.Styles("one_car")
  Selection.Find.Replacement.ClearFormatting
  With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
  End With
  Selection.Find.Execute
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.TypeText Text:="."
Loop
End Sub

Thanks!

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
Set Rng = ActiveDocument.Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
    .Text = "abc"
    .Style = "one_car"
    .Replacement.Text = ""
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .MoveStart Unit:=wdCharacter, Count:=-3
    .InsertBefore ","
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  .Start = Rng.Start
  With .Find
    .Text = ""
    .Execute
  End With
  Do While .Find.Found
    .InsertAfter "."
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

or, even simpler:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
    .Text = "abc"
    .Style = "one_car"
    .Replacement.Text = ""
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .MoveStart Unit:=wdCharacter, Count:=-3
    .InsertBefore ","
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  With .Find
    .Text = ""
    .Replacement.Text = "^&."
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

PS: When posting code, please use the code tags. They're on the 'Go Advanced' tab.