CODEWITHSUNDEEP
excelvbacolors
barbieprincess
barbieprincess

Reputation: 3

How do I copy only the red text in a cell to another cell?

I have cells that contain different colour text in Excel. I want to be able to extract the text that is in a particular colour to another cell.

How can I amend my UDF to account for this?

Function RedText(Rng As Range) As String
  Dim X As Long, S As String
  S = Rng.Text
  For X = 1 To Len(Rng.Text)
    If Rng.Characters(X, 1).Font.Color <> vbRed Then
      If Mid(S, X, 1) <> vbLf Then Mid(S, X, 1) = " "
    End If
  Next
  RedText = Replace(Replace(Application.Trim(S), " " & vbLf, vbLf), vbLf & " ", vbLf)
End Function

Thanks

Upvotes: 0

Views: 231

Answers (1)

Tim Williams
Tim Williams

Reputation: 166540

For example:

Function TextByColor(Rng As Range, hex As String) As String
  Dim X As Long, S As String, clr As Long
  S = Rng.Text
  clr = HexToRGB(hex)
  For X = 1 To Len(Rng.Text)
    If Rng.Characters(X, 1).Font.Color <> clr Then
      If Mid(S, X, 1) <> vbLf Then Mid(S, X, 1) = " "
    End If
  Next
  RedText = Replace(Replace(Application.Trim(S), " " & vbLf, vbLf), vbLf & " ", vbLf)
End Function

Function HexToRGB(hex As String) As Long
    Dim r, g, b
    r = Application.Hex2Dec(Left(hex, 2))
    g = Application.Hex2Dec(Mid(hex, 3, 2))
    b = Application.Hex2Dec(Right(hex, 2))
    HexToRGB = RGB(r, g, b)
End Function

'Added: >10x faster alternative to using `Application.Hex2Dec`
Function HexToRGB2(hex As String) As Long
    Dim r As Long, g As Long, b As Long
    b = CLng("&H" & Right(hex, 2))
    g = CLng("&H" & Mid(hex, 3, 2))
    r = CLng("&H" & Left(hex, 2))
    HexToRGB2 = RGB(r, g, b)
End Function

Usage: =textbycolor(A3,"0000FF")

As noted in the comments - here's why you can't use HEX2DEC on the full hex value (R and G components get switched):

enter image description here

Upvotes: 3

Related Questions