creating a visual basic command that will underline a specific word plus the character after it

Question

I am creating a visual basic command that will underline a specific word, plus the character after it.  For example, Exhibit A, Schedule 1A, or Section 4(a)(1)(iii).  The following command is one that will underline the word "Exhibit" but it I need to modify it to also Underline the following characters.  This will help save a lot of time  when a pdf is converted to word and I need to format the document.  Can anyone help me modify this?  Thanks in advance.

Sub Demo()

Application.ScreenUpdating = False

Dim StrFnd As String, i As Long

StrFnd = "Exhibit"

With ActiveDocument.Range.Find

.ClearFormatting

.Replacement.ClearFormatting

.Replacement.Text = "^&"

.Replacement.Font.Underline = wdUnderlineSingle

  .Forward = True

.Wrap = wdFindContinue

.MatchCase = True

.MatchWholeWord = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

For i = 0 To UBound(Split(StrFnd, ","))

.Text = Split(StrFnd, ",")(i)

.Execute Replace:=wdReplaceAll

Next

End With

Application.ScreenUpdating = True

End Sub

Answer 1

Doug has very kindly provided some modified code that may work better for your purposes. I would modify it as follows, so it doesn't underline a comma that follows Exhibit A:

Sub Demo2()

  With Selection

    .HomeKey wdStory

    .Find.ClearFormatting

    With .Find

      Do While .Execute(FindText:="Exhibit ^?", MatchWildcards:=False, MatchWholeWord:=True, Forward:=True, Wrap:=wdFindStop) = True

        With Selection

          .MoveEndUntil Cset:=" " & ","

          .Font.Underline = wdUnderlineSingle

          .Collapse wdCollapseEnd

        End With

      Loop

    End With

  End With

End Sub

Answer 2

Use:

Selection.HomeKey wdStory

Selection.Find.ClearFormatting

With Selection.Find

    Do While .Execute(FindText:="Exhibit ^?", MatchWildcards:=False, MatchWholeWord:=True, Forward:=True, Wrap:=wdFindStop) = True

        With Selection

            .MoveEndUntil Cset:=" "

            .Font.Underline = wdUnderlineSingle

            .Collapse wdCollapseEnd

        End With

    Loop

End With

Answer 3

Thanks to the both of you for helping me with this.  It executes perfectly.

Answer 4

This worked beautifully with the Exhibits marked as Exhibit A but for other Exhibits such as Exhibit A-1 it only underlined up to the American not the -1 part.  I can go underline that manually.

Answer 5

Changing

StrFnd = "Exhibit"

to

StrFnd = "Exhibit ^?"

should do it.