Option Compare Text

Sub Find_n_Highlight()
    On Error Resume Next: Err.Clear
    Dim ra As Range, cell As Range, res, txt$, v, pos&, arFind, f
    res = InputBox("Введите текст, который необходимо подсветить в таблице", "Поиск и подсветка текста", "ФИО:, контактный телефон:, клуб:, Время инцидента:, имя и приметы")
    If VarType(res) = vbBoolean Then Exit Sub    ' нажата кнопка ОТМЕНА
    txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub    ' текст не введен, или состоит из пробелов
    Application.ScreenUpdating = False
    Set ra = Range(["A1:A500"], Range("A" & Rows.Count).End(xlUp))    ' диапазон для поиска
    ra.Font.Color = 0: ra.Font.Bold = 0  ' сброс цветового выделения
    arFind = Split(txt, ",")
    For Each f In arFind
        For Each cell In ra    ' перебираем все ячейки
            pos = 1
            If cell.Text Like "*" & f & "*" Then
                arr = Split(cell.Text, f, , vbTextCompare)   ' разбивает текст ячейки на части
                If UBound(arr) > 0 Then    ' если подстрока найдена
                    For Each v In arr    ' перебираем все вхождения
                        pos = pos + Len(v)    ' начальная позиция
                        With cell.Characters(pos, Len(f))

                            .Font.Bold = True    ' и полужирным начертанием
                        End With
                        pos = pos + Len(f)
                    Next v
                End If
            End If
        Next cell
    Next f
End Sub

For Each f In arFind
    f = Trim(f)