Если в ячейке есть слово "Услуга", то в данной ячейке текст выделять жирным

Sub Test()
Dim rng As Range, gr As Range
Dim arr, r&, c&
 
Set rng = Selection
'Set rng = Worksheets("ИмяЛиста").Range("A1:D1000") ' тут пример, как можно задать другой диапазон
 
arr = rng.Value2
 
For c = 1 To UBound(arr, 2)
    For r = 1 To UBound(arr, 1)
        If InStr(arr(r, c), "Услуга") Then
            If gr Is Nothing Then
                Set gr = rng.Cells(r, c)
            Else
                Set gr = Union(gr, rng.Cells(r, c))
            End If
        End If
    Next r
Next c
 
If Not gr Is Nothing Then gr.Font.Bold = True
End Sub

Sub anton24_2()
 
Const KeyWord As String = "Услуга"
Dim WS As Worksheet: Set WS = Worksheets("тестовый лист")
Dim Rall As Range
 
Application.ScreenUpdating = False
 
With WS
    Set Rall = .Range("A1").CurrentRegion
    Rall.Font.Bold = False
    For Each R In Rall
        If InStr(1, R, KeyWord, vbTextCompare) <> 0 Then R.Font.Bold = True
    Next
End With
Application.ScreenUpdating = True
 
End Sub

Sub t()
Dim s$, t!, n&, i&
Const nCyc& = 10000000
 
s = "васька"
 
t = Timer
    For n = 1 To nCyc
        i = InStr(s, "а")
    Next n
Debug.Print 1, Format$(Timer - t, "0.00"), i    ' 0.19 | 2
 
s = "василий"
 
t = Timer
    For n = 1 To nCyc
        i = InStr(s, "й")
    Next n
Debug.Print 2, Format$(Timer - t, "0.00"), i    ' 0.21 | 7
 
 
s = "василий васильевич василевсКий"
 
t = Timer
    For n = 1 To nCyc
        i = InStr(s, "К")
    Next n
Debug.Print 3, Format$(Timer - t, "0.00"), i    ' 0.27 | 28
 
t = Timer
    For n = 1 To nCyc
        i = InStr(1, s, "к", vbTextCompare)
    Next n
Debug.Print 4, Format$(Timer - t, "0.00"), i    ' 2.50 | 28
 
t = Timer
    For n = 1 To nCyc
        i = InStr(1, s, "К", vbTextCompare)
    Next n
Debug.Print 5, Format$(Timer - t, "0.00"), i    ' 2.57 | 28
 
t = Timer
    For n = 1 To nCyc
        i = InStr(LCase$(s), "к")
    Next n
Debug.Print 6, Format$(Timer - t, "0.00"), i    ' 1.50 | 28
 
 
s = UCase$(s)
 
t = Timer
    For n = 1 To nCyc
        i = InStr(1, s, "к", vbTextCompare)
    Next n
Debug.Print 7, Format$(Timer - t, "0.00"), i    ' 2.48| 28
 
t = Timer
    For n = 1 To nCyc
        i = InStr(1, s, "К", vbTextCompare)
    Next n
Debug.Print 8, Format$(Timer - t, "0.00"), i    ' 2.46 | 28
 
t = Timer
    For n = 1 To nCyc
        i = InStr(LCase$(s), "к")
    Next n
Debug.Print 9, Format$(Timer - t, "0.00"), i    ' 1.50 | 28
 
End Sub