0
votes

I am trying to restrict the search for red text in a Word document to a single table cell. Whatever I try, the whole document is searched. I have got as far as the following:

Sub FindRedText()
    Dim MyArray() As String
    Dim result As String
    Dim i As Long

'Dim RngFnd As Range

i = 0

Selection.SelectCell
'Set RngFnd = Selection.Range
Selection.Find.ClearFormatting
Selection.Find.Font.Color = wdColorRed

Do While Selection.Find.Execute = True
'If RngFnd.InRange(RngFnd) Then
        ReDim Preserve MyArray(i)
        MyArray(i) = Selection
        i = i + 1
'Else
'End If
    Loop

    If i = 0 Then
        MsgBox "No Red Text"
        Exit Sub
    End If

    For i = LBound(MyArray) To UBound(MyArray)
        result = Join(MyArray, ", ")
    Next i

End Sub

I have left my comments in to show my failed attempts to set the current selection as a range. When I do so, all the text in the cell is copied into the array.

As an example, say I have the following:

In table cell 1,1 (selected): "red text1", "blue text1", "red text2" In table cell 1,2: "red text3"

My macro currently puts "red text1", "red text2" and "red text3" into my array and final result string. I just want "red text1" and "red text2" (i.e. a search of the selected cell only).

1

1 Answers

0
votes

Try this: First select area, then run this.

Sub FindSelectionColorText()
Selection.Find.ClearFormatting

With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Font.Color = RGB(255, 0, 0)  'wdColorRed
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
    Selection.Find.Execute
End Sub

'if answer works, Mark as answer and/or upvote, else comment what happened.