Sub Color_String_in_Cell()
 Dim rCell As Range
 Dim X As Long
 Dim y As Long
 Dim mystr As String
 
 'ColorTextInCell.Show
 
 mystr = InputBox("Enter a string")
 y = Len(mystr)
 For Each rCell In Selection
     X = 1
     Do
       X = InStr(X, UCase(rCell.value), UCase(mystr))
       If X > 0 Then
           rCell.Characters(X, y).Font.Color = vbBlue
           X = X + 1
       End If
     Loop Until X = 0
 Next rCell
 End Sub