Sub iTextColor()
Dim i As Long
Dim j As Integer
Dim n As Integer
Dim iLR As Long
Dim objMatches As Object
Dim objMatch As Object
  iLR = Cells(Rows.Count, 1).End(xlUp).Row
      Columns("A:A").Font.ColorIndex = 0
 With CreateObject("VBScript.RegExp")
   .Global = True
   .IgnoreCase = True
   For n = 2 To Cells(Rows.Count, 2).End(xlUp).Row
     Cells(n, 2).Font.ColorIndex = n + 1
      For i = 2 To iLR
        .Pattern = Cells(n, 2)
        Set objMatches = .Execute(Cells(i, 1))
          If objMatches.Count <> 0 Then
             For j = 0 To objMatches.Count - 1
                Set objMatch = objMatches.Item(j)
                With Cells(i, 1).Characters(Start:=objMatch.FirstIndex + 1, Length:=objMatch.Length).Font
                    .ColorIndex = n + 1
                End With
             Next
          End If
      Next
   Next
 End With
End Sub