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