Option Explicit
Sub colorize1()
Dim x%, k%, i%
Dim MY_St1$, MY_St2$, find_txt$
Dim My_Txt
MY_St1$ = UCase(Range("a2")): MY_St2$ = UCase(Range("c2"))
Application.ScreenUpdating = False
With Range("a2").Font
.ColorIndex = 0: .Underline = False:
.Italic = False: .Bold = False
End With
If MY_St1 = vbNullString Or MY_St2 = vbNullString Then
MsgBox "Nothing to Do" & Chr(10) & "Bay Bay"
GoTo Exite_Me
End If
For i = 1 To Len(MY_St1) - Len(MY_St2) + 1
find_txt$ = Mid(MY_St1, i, Len(MY_St2))
If find_txt$ = MY_St2 Then
With Range("a2").Characters(i, Len(MY_St2)).Font
.ColorIndex = 3: .Underline = True:
.Italic = True: .Bold = True
k = k + 1
End With
End If
Next
Select Case k
Case 0: Range("b2") = "Nothing similar"
Case Else: Range("b2") = "There are: " & Chr(10) & k & " Expressions"
End Select
If k = 1 Then Range("b2") = Mid(Range("b2"), 1, Len(Range("b2")) - 1)
Exite_Me:
Application.ScreenUpdating = True
End Sub