Do While - Loop - not working in loop

[dagerr]

Hi,
I have a following code, and it is not working in a loop, because it is finding i convert searched text only one time not as many times as it occurrence.
Thanks for helping.


Sub FOTO()

Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find

Do While .Execute(FindText:="FOTO", MatchWholeWord:=True)

oRng.End = oRng.Paragraphs(1).Range.End

With oRng
.Font.Name = "Times New Roman"
.Font.Size = 5
'.Font.Italic = wdToggle
.bold = False
.Font.SmallCaps = False
.Font.AllCaps = True
With .ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceMultiple
.LineSpacing = LinesToPoints(0.9)
.Alignment = wdAlignParagraphJustify
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
End With

Exit Do
Loop
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

[gmayor]

It only finds one instance because you have the line Exit Do which stops the loop after the first instance. You need to make a couple of changes for the loop to work throughout the document range.


End With
.Collapse 0 'add this line
End With

'Exit Do 'remove this line
Loop
End With
lbl_Exit:

[dagerr]

You solved it as usually.
Thanks