Set the next word in capital letters in Arial Black font

Hello,
I am new to this forum.


I'm trying to write a macro that changes the font of the next word written in capital letters (set them in Arial Black).

I know how to skip to the next word

Code:

---

Selection.MoveRight Unit:=wdWord, Count:=1

---

And, after searching the internet for a while, I've understood that I could use this method :

Code:

---

If UCase(MyText) = MyText Then ..

---

I've also read that, to have this work, it should come after this code :

Code:

---

OptionCompareBinary

---

....but I know too little about VBA to write the whole macro.

Could anyone help me do this, please ?

Many thanks.

The problem with such a macro is in determining where the next 'word' starts and ends as Word does not necessarily interpret what is a 'word' as may you. The following should work in most circumstances.

Code:

---

Sub FormatNextWord()'Graham Mayor - https://www.gmayor.com - Last updated - 02 Dec 2019
Dim strList As String
Dim orng As Range
    strList = Chr(9) & Chr(11) & Chr(13) & Chr(32) & Chr(33) & Chr(34) & _
              Chr(39) & Chr(41) & Chr(44) & Chr(46) & Chr(58) & Chr(59) & Chr(63)
    Set orng = Selection.Words.Last
    With orng
        .MoveEndWhile strList
        .Collapse 0
        .MoveEndUntil strList
        .Font.AllCaps = True
        .Font.Name = "Arial Black"
    End With
lbl_Exit:
    Set orng = Nothing
    Exit Sub
End Sub

---

Thank you !
But while using your code, I realized that, due to the fact that I'm not fluent in english, the way I asked my question was misleading (sorry about that).
To put it more clearly :
– what your code does : find the next word >>> turn it into capital letters in Arial Black Font
– what I'd like it to do : find the next word in capital letters >>> turn it into Arial Black Font
I hope it's feasible.

How about

Code:

---

Sub Macro1()
Dim oRng As Range
Dim i As Long
    Set oRng = ActiveDocument.Range
    oRng.Start = Selection.Range.Start
    For i = 2 To oRng.Words.Count
        If oRng.Words(i).Case = wdUpperCase And Len(oRng.Words(i)) > 2 Then
            oRng.Words(i).Font.Name = "Arial Black"
            Exit For
        End If
    Next i
    Set oRng = Nothing
End Sub

---

Thanks, it's fantastic !

........although I need a little "improvement" : I need to be able to change the font of words in capital letters one after the other, but with your code, the insertion point remains unchanged after the macro is executed.
So I've tried to change your code to make Word skip to the next word.

Code:

---

Dim oRng As RangeDim i As Long
    Set oRng = ActiveDocument.Range
    oRng.Start = Selection.Range.Start
    For i = 2 To oRng.Words.Count
        If oRng.Words(i).Case = wdUpperCase And Len(oRng.Words(i)) > 2 Then
            oRng.Words(i).Font.Name = "Arial Black"
           
            Application.Selection.Words(1).Select
            Selection.MoveRight Unit:=wdWord, Count:=1


            Exit For
        End If
    Next i
    Set oRng = Nothing

---

But it does not work : Word goes back to the insertion point that was set before the macro was launched.
Could you please help me solve this (this should be the last time) ?
Thanks !

Remove the line

Code:

---

Exit For

---

from my macro and it will apply the font to all capitalised Words to the end of the document.

If you prefer to do them one at a time, then set the selection to the end of the word you have just processed e.g.

Code:

---

Sub Macro1()
Dim oRng As Range
Dim i As Long
    Set oRng = ActiveDocument.Range
    oRng.Start = Selection.Range.Start
    For i = 2 To oRng.Words.Count
        If oRng.Words(i).Case = wdUpperCase And Len(oRng.Words(i)) > 2 Then
            oRng.Words(i).Font.Name = "Arial Black"
            oRng.Start = oRng.Words(i).End
            oRng.Collapse 1
            oRng.Select
            Exit For
        End If
    Next i
    Set oRng = Nothing
End Sub

---

However if you want to format them all, replace is much faster

Code:

---

Sub Macro2()
Dim oRng As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .Replacement.Font.Name = "Arial Black"
        .Execute findText:="[ABCDEFGHIJKLMNOPQRSTUVWXYZ]{2,}", _
                MatchWildcards:=True, _
                Replace:=wdReplaceAll
    End With
    Set oRng = Nothing
End Sub

---

Thank you SOOOOO MUCH !
I appreciate.
And thanks for explaining in detail.
:clap::clap::clap::clap::clap::clap: