Extract text based on font colour

**mn2005** · 08-06-2021, 06:55 AM

I currently have a column with a few hundred rows. Each cell has text with three main standard colours (yellow, red and blue). Occasionally i have a cell with 'N/A' in automatic font.

I'm trying to extract the text based on the font colour to a new column.

A1

5.1 Debris in area
7.4 Gap too large
7.5 Not adequately sealed
Misc. -wear and tear.
Misc. - scratches

So the text above would be split into another three columns based on the three font colours. I have found the following macro from a different site to extract the red text and it works perfectly. However i'm not too sure how to repeat for Blue and Orange text.

Function GetColorText(pRange As Range) As String
    'Updateby20141105
    Dim xOut As String
    Dim xValue As String
    Dim i As Long
    xValue = pRange.Text
 
    For i = 1 To VBA.Len(xValue)
 
        If pRange.Characters(i, 1).Font.Color = vbRed Then
            xOut = xOut & VBA.Mid(xValue, i, 1)
        End If
 
    Next
 
    GetColorText = xOut
End Function

Many thanks

**Artik** · 08-06-2021, 08:32 AM

You can use the GetColorText function, slightly modifying it:

Function GetColorText(pRange As Range, RGBColor As String) As String
    Dim xOut        As String
    Dim xValue      As String
    Dim i           As Long
    Dim v As Variant
    
    v = Split(RGBColor, ",")
    
    
    xValue = pRange.Text

    For i = 1 To VBA.Len(xValue)

        If pRange.Characters(i, 1).Font.Color = RGB(v(0), v(1), v(2)) Then
            xOut = xOut & VBA.Mid(xValue, i, 1)
        End If

    Next

    GetColorText = xOut
End Function

An example of use is included in the attachment. This is not the only way.
You can pass the second argument of the function as a reference to a cell containing color components (K1, K2 or K3)