Cambiar color de fuente de determinadas palabras en texto concatenado en Excel

Código

Sub IB·CambiarColorFuente()

Dim r As Range, x As Range, c As Range, p As Range, b() As String, h As Long

On Error Resume Next

Set r = Application.InputBox("Selecciona el rango donde se aplicará el cambio de color de fuente:", "INGENIERÍA & BURÓTICA", , Type:=8)

On Error GoTo 0

On Error Resume Next

Set x = Application.InputBox("Selecciona el rango con las palabras a cambiar el color de fuente:", "INGENIERÍA & BURÓTICA", , Type:=8)

On Error GoTo 0

h = RGB(255, 0, 0)

Dim colorHex As String

colorHex = InputBox("Ingresa el color de fuente deseado en formato hexadecimal:", "INGENIERÍA & BURÓTICA")

If colorHex <> "" Then

On Error Resume Next

h = RGB( _

CLng("&H" & Mid(colorHex, 1, 2)), _

CLng("&H" & Mid(colorHex, 3, 2)), _

CLng("&H" & Mid(colorHex, 5, 2)) _

)

On Error GoTo 0

If h = 0 Then

MsgBox "Formato de color no válido. Asegúrate de ingresar seis caracteres hexadecimales."

Exit Sub

End If

Else

Exit Sub

End If

If Not r Is Nothing And Not x Is Nothing Then

ReDim b(1 To x.Cells.Count)

Dim i As Integer

i = 1

For Each p In x

b(i) = p.Value

i = i + 1

Next p

For Each c In r

For i = LBound(b) To UBound(b)

If InStr(1, " " & c.Value & " ", " " & b(i) & " ") > 0 Then

Dim posInicio As Integer

posInicio = InStr(1, " " & c.Value & " ", " " & b(i) & " ")

c.Characters(Start:=posInicio, Length:=Len(b(i))).Font.Color = h

End If

Next i

Next c

Else

MsgBox "No se han seleccionado rangos válidos."

End If

End Sub