Find and Replace

[Bikram]

Greeting to all, I wrote the following code to find and replace multiple fonts but it is not working

Sub Macro39()

 Dim i As Integer
 Dim fta()
 
    fta = Array("Book Antiqua", "Arial Narrow","Arial")
        For i = 0 To UBound(fta)
            With Selection.find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Font.Bold = True
                .Font.Name = fta(i)
            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
                Do While Selection.find.Execute = True
                    Select Case Selection.Range.Style
                    Case "tt"
                        Selection.Range.Select
                            With Selection
                                .Font.Name = "Lato Heavy"
                                .Font.Size = 7.5
                                .Font.Bold = False
                                .MoveRight unit:=wdWord, Count:=1
                            End With
                    Case "aq", "b"
                        With Selection
                            .Font.Name = "Arial"
                            .Font.Size = 7.5
                            .Font.Bold = False
                            .MoveRight unit:=wdWord, Count:=1
                      End With
                    End Select
                Loop
        Next
End Sub

It works but only for the first item in the array. Can someone point out why is it not working as expected? Thanks in advance.

[Guessed]

I would start by looking at the .Wrap = wdFindStop
This would be telling the code to stop when it gets to the end of the document. At the end of the first pass, your selection object would be near the end so if there are no second pass entries between it and the end of the document then nothing will be found.

You could change it to wdFindContinue or reset the selection to the top of the document at the start of each loop.

[Bikram]

Thank you Andrew, it worked.