@enggrahul78,
Here is a macro that will directly gather all of the individual unique red words in column A (change the red colored A's below to your actual column letter designation) and place them in a one-based array which I have named RedText in the code below.
Sub MakeArrayOfUniqueRedTextWords() Dim R As Long, X As Long, Rng As Range, Cell As Range, Arr As Variant, RedText As Variant
Set Rng = Range("A1", Cells(Rows.Count, "A").End(xlUp))
Arr = Application.Transpose(Rng.Value)
For Each Cell In Rng
R = R + 1
For X = 1 To Len(Arr(R))
If Mid(Arr(R), X, 1) = " " Or Cell.Characters(X, 1).Font.Color <> vbRed Then Mid(Arr(R), X) = " "
Next
Arr(R) = Application.Trim(Arr(R))
Next
Arr = Split(Join(Arr))
With CreateObject("Scripting.Dictionary")
For X = 0 To UBound(Arr)
.Item(Arr(X)) = 1
Next
RedText = Application.Transpose(.Keys)
End With
'
' At this point in the macro, RedText is a one-based array
' containing all of the individual words that were red color
'
End Sub |