Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rw&, N&, Cl As Range
   Rw = Cells(Rows.Count, 8).End(xlUp).Row
   If Not Intersect(Target, Range("A14:H" & Rw)) Is Nothing Then
       N = Cells(Target.Row, 8)
       Range("A14:H" & Rw).Interior.Color = xlNone
       For Each Cl In Range("H14:H" & Rw)
           If Cl = N Then Cl.Offset(, -7).Resize(, 8).Interior.Color = vbRed
       Next
   End If
End Sub

Private Sub worksheet_selectionchange(ByVal target As Range)
Columns(1).FormatConditions.Delete
Dim Z As Variant
Z = ActiveCell.Value
PoiskSlov = Z
Columns(1).FormatConditions.Add Type:=xlTextString, String:=PoiskSlov, TextOperator:=xlContains
Columns(1).FormatConditions(Columns(1).FormatConditions.Count).SetFirstPriority
With Columns(1).FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535 ' цвет
End With
Columns(1).FormatConditions(1).StopIfTrue = False
End Sub

Dim arr(), k As Long ' arr - это глобальный массив диапазонов, в которые сохраняются адреса ячеек после запуска макроса Поиск_и_форматирование
Sub Поиск_и_форматирование()
Dim rData As Range, rRow As Long, aRange As Range
With ActiveSheet ' активный лист
    Set rData = .UsedRange ' весь заполненный диапазон активного листа
    Set aRange = rData.Columns(8).Find(ActiveCell.Value, LookAt:=xlWhole) ' ищет совпадения только в 8 столбце по точному совпадению (параметр LookAt:=xlWhole)
    If Not aRange Is Nothing Then  ' если совпадение найдено (хотя бы одно) и ячейка не пустая
        If aRange.Value <> "" Then
            Call очистка_форматирования ' очищаем предыдущие форматы на основе массива arr
            rRow = aRange.Row ' запоминаем строку с первым найденным совпадением
            k = 1 ' переменная - счетчик для массива
            Do
                '===================================
                ' заполняем массив найденными ячейками
                ReDim Preserve arr(1 To k)
                arr(k) = aRange.Address(0, 0)
                k = k + 1
                '===================================
                aRange.Interior.Color = vbYellow ' красим в желтый цвет найденные ячейки
                Set aRange = rData.Columns(8).FindNext(aRange)
            Loop While Not aRange Is Nothing And rRow <> aRange.Row
        End If
    End If
End With
End Sub
Private Sub очистка_форматирования()
Dim i
On Error GoTo label ' если массив не заполнен или другая ошибка, то выходим из процедуры (после label)
    With ActiveSheet ' активный лист
        For Each i In arr
        .Range(i).ClearFormats ' очищаем форматирование
        Next i
    End With
Exit Sub
label:
End Sub

Dim arr(), k As Long ' arr - это глобальный массив диапазонов, в которые сохраняются адреса ячеек после запуска макроса Поиск_и_форматирование
Sub Поиск_и_форматирование()
Dim rData As Range, rRow As Long, aRange As Range, colToFind As Long, WhatX As String
With ActiveSheet ' активный лист
    Set rData = .UsedRange ' весь заполненный диапазон активного листа
    WhatX = Application.InputBox("Введите слово для поиска", Type:=2) ' запрашивает строку для поиска
    Set aRange = rData.Find(WhatX, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) ' ищет только значения по частичному совпадению (параметр LookAt:=xlPart) _
                    и без учета регистра (параметр MatchCase:=False) в диапазоне rData
    If Not aRange Is Nothing Then ' если совпадение найдено (хотя бы одно) и ячейка не пустая
        Call очистка_форматирования ' очищаем предыдущие форматы на основе массива         rRow = aRange.Row ' запоминаем строку с первым найденным совпадением
        k = 1 ' переменная - счетчик для массива
        rRow = aRange.Row
        Do
            '===================================
            ' заполняем массив найденными ячейками
            ReDim Preserve arr(1 To k)
            arr(k) = aRange.MergeArea.Address(0, 0)
            Debug.Print arr(k)
            k = k + 1
            '===================================
            aRange.Interior.Color = vbYellow ' красим в желтый цвет найденные ячейки
            Set aRange = rData.FindNext(aRange)
        Loop While Not aRange Is Nothing And rRow <> aRange.Row
    End If
End With
End Sub
Private Sub очистка_форматирования()
Dim i
On Error GoTo label ' если массив не заполнен или другая ошибка, то выходим из процедуры (после label)
    With ActiveSheet ' активный лист
        For Each i In arr
            .Range(i).ClearFormats ' очищаем форматирование, если массив заполнен (Join(arr, ",") == сцепляем массив по разделителю ", ")
        Next i
    End With
Exit Sub
label:
End Sub