Option Explicit

'---------------------------------------------------------------------------------------

' Author : The_Prist(Щербаков Дмитрий)

'          Профессиональная разработка приложений для MS Office любой сложности

'          Проведение тренингов по MS Excel

'          https://www.excel-vba.ru

'          info@excel-vba.ru

'          WebMoney - R298726502453; Яндекс.Деньги - 41001332272872

' Purpose:

'---------------------------------------------------------------------------------------

Sub FindErrLink()

    'надо посмотреть в Данные -Изменить связи ссылку на файл-иточник

    'и записать сюда ключевые слова в нижнем регистре(часть имени файла)

    'звездочка просто заменяет любое кол-во символов, чтобы не париться с точным названием

    Const sToFndLink$ = "*продажи 2018*"

    Dim rr As Range, rc As Range, rres As Range, s$

    'определяем все ячейки с проверкой данных

    On Error Resume Next

    Set rr = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)

    If rr Is Nothing Then

        MsgBox "На активном листе нет ячеек с проверкой данных", vbInformation, "www.excel-vba.ru"

        Exit Sub

    End If

    On Error GoTo 0

    'проверяем каждую ячейку на предмет наличия связей

    For Each rc In rr

        'на всякий случай пропускаем ошибки - такое тоже может быть

        'но наши связи должны быть без них и они точно отыщутся

        s = ""

        On Error Resume Next

        s = rc.Validation.Formula1

        On Error GoTo 0

        'нашли - собираем все в отдельный диапазон

        If LCase(s) Like sToFndLink Then

            If rres Is Nothing Then

                Set rres = rc

            Else

                Set rres = Union(rc, rres)

            End If

        End If

    Next

    'если связь есть - выделяем все ячейки с такими проверками данных

    If Not rres Is Nothing Then

        rres.Select

'        rres.Interior.Color = vbRed 'если надо выделить еще и цветом

    End If

End Sub