Function extract_color(rng As Range)
    Dim FontCol, x As Long, txt As String
    FontCol = RGB(255, 0, 0)
    txt = ""

    For x = 1 To rng.Characters.Count
        If rng.Characters(x, 1).Font.Color = FontCol Then txt = txt & rng.Characters(x, 1).Text
    Next x

    If Len(txt) > 0 Then ActiveCell.Font.Color = FontCol Else ActiveCell.Font.Color = xlAutomatic
    extract_color = txt

End Function
Hi angrygorilla and NickyC

I have made a small change to the macro from Nicky. There was a typo in the code - color was spelled two ways!

Regards, David


When you reply please make it clear WHO you are responding to by mentioning their name.
If this has been of assistance, please advise. A little thanks goes a long way.
- Please click on the *Add Reputation button at the bottom of helpful responses.
Please mark your thread as SOLVED:
- Click Thread Tools above your first post, select "Mark your thread as Solved".