I am trying to extract the words in cells that are colored in red. Here's what I have tried till now
Code: Select all
Sub Test()
Dim a()
a = GetColorText(ActiveCell)
End Sub
Function GetColorText(r As Range)
Dim a(), b As Boolean, s As String, t As String, x As Long, i As Long
t = r.Text
For x = 1 To Len(t)
If r.Characters(x, 1).Font.Color = vbRed Then
b = True: s = s & Mid(t, x, 1)
Else
b = False
End If
If b = False And s <> "" Then
ReDim Preserve a(i): a(i) = s: i = i + 1: s = vbNullString
End If
Next x
GetColorText = a
End Function
Finally to list the extracted words into column G for example