Find and Replace

Bikram · #1 12-10-2021, 03:52 AM

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

Code:

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 · #2 12-12-2021, 03:34 AM

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 · #3 12-12-2021, 05:05 AM

Thank you Andrew, it worked.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How do you use the find and replace tool to find dates and times in Excel 2013?	Jules90	Excel	3	04-14-2020 07:40 PM
In Find and Replace, can Word stop after each Replace?	wardw	Word	1	06-08-2017 02:47 PM
Find what box in Find and replace limits the length of a search term	Hoxton118	Word VBA	7	06-10-2014 05:05 AM
Bad view when using Find and Find & Replace - Word places found string on top line	paulkaye	Word	4	12-06-2011 11:05 PM
Help with find and replace or query and replace	shabbaranks	Excel	4	03-19-2011 08:38 AM