VBA: Select text in cell until the next character is bold

Question

I am trying to select all the text under a subheading inside a table cell in Microsoft Word. It is working fine when there is a subheading after the text, but if it is the last subheading in the cell it selects the whole cell. Is there a way to check Selection.Next for the end of the cell?

Here is my code so far:

Public Sub copySubHeading()
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .MatchCase = False
        .Text = "Example:"
        .Wrap = wdFindContinue
        .Font.Bold = True
        .Execute
    End With
    Selection.MoveRight Unit:=wdCell, Count:=1, Extend:=wdMove
    With Selection.Find
        .ClearFormatting
        .MatchCase = False
        .Text = "Heading 6:"
        .Wrap = wdFindContinue
        .Font.Bold = True
        .Execute
    End With
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove
    While IsAlphanumericCharacter(Selection) <> True
        Selection.Next(Unit:=wdCharacter, Count:=1).Select
    Wend
    While Not Selection.Next.Bold
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Wend
End Sub

Private Function IsAlphanumericCharacter(character As String) As Boolean
    Select Case Asc(character)
        Case 48 To 57, 65 To 90, 97 To 122
            IsAlphanumericCharacter = True
        Case Else
            IsAlphanumericCharacter = False
    End Select
End Function

This code above will work when the cell ends with whatever this special character is in the picture below, although the cells I have to work with do not end with this character every time.

Most time the cell will end with the character at the end of the cell below.

Is there a way to select the text until either a bold character or the end of the cell?

Or if someone can offer a better way to select all the text until the next heading that would be very helpful, thanks.

Is the final character I have highlighted in yellow a paragraph mark? I thought a paragraph symbol was the ones at the end of the headings. — enifeder
Also the problem is not regarding finding the bold text, it is making it stop at the end of the cell. — enifeder
The final character (yellow highlight) is a combination of ANSI 13 & ANSI 7, commonly called "paragraph mark" and "end of cell marker". But visually the combination is represented as a "sunshine". If you check for ANSI 13 followed by ANSI 7 (using the ASC or CHR function) you should be able to identify end-of-cell. — Cindy Meister

enifeder enifeder · Accepted Answer · 2016-03-04T03:53:19

I was able to solve the problem with the following code. It required adding a character counter to check when the whole cell was selected.

It is not the nicest but it does the job. If anyone comes across an simpler way please let me know.

Public Sub copySubHeading(subheading As String)
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .MatchCase = False
        .Text = "Example:"
        .Wrap = wdFindContinue
        .Font.Bold = True
        .Execute
    End With
    Selection.MoveRight Unit:=wdCell, count:=1, Extend:=wdMove
    With Selection.Find
        .ClearFormatting
        .MatchCase = False
        .Text = subheading
        .Wrap = wdFindContinue
        .Font.Bold = True
        .Execute
    End With
    If Selection.Find.Found Then
        Selection.MoveRight Unit:=wdCharacter, count:=1, Extend:=wdMove
        moveSelectionUntilOnAlphanumericCharacter
        extendSelectionUntilNextHeadingOrCountMet Selection.Range
        Selection.Copy
    End If
End Sub

Private Sub extendSelectionUntilNextHeadingOrCountMet(selection As Range, Optional count As Integer = -1)
    Dim characterCount As Integer
    Dim startPoint As Range
    Set startPoint = selection
    startPoint.Select
    characterCount = 1

    Do While Not (Selection.Next = ":" And Selection.Next.Bold)
        Selection.MoveRight Unit:=wdCharacter, Extend:=wdExtend
        characterCount = characterCount + 1
        If Selection.Characters.count <> characterCount Then
            characterCount = characterCount - 1
            Selection.Collapse
            extendSelectionUntilNextHeadingOrCountMet startPoint, characterCount
            Exit Do
        End If
        If characterCount = count Then
            Exit Do
        End If
    Loop
    reduceSelectionUntilNotOnBoldCharacterOrPreviousHeader
End Sub

Private Sub reduceSelectionUntilNotOnBoldCharacterOrPreviousHeader()
    Do While Selection.Next.Bold And Selection.Previous <> ":"
        Selection.MoveLeft Unit:=wdCharacter, Extend:=wdExtend
    Loop
End Sub

Private Sub moveSelectionUntilOnAlphanumericCharacter()
    Do While IsAlphanumericCharacter(Selection) <> True
        Selection.Next(Unit:=wdCharacter, count:=1).Select
    Loop
End Sub

Private Function IsAlphanumericCharacter(character As String) As Boolean
    Select Case Asc(character)
        Case 48 To 57, 65 To 90, 97 To 122
            IsAlphanumericCharacter = True
        Case Else
            IsAlphanumericCharacter = False
    End Select
End Function

Hopefully someone will find this useful in the future.

VBA: Select text in cell until the next character is bold

1 Answers