Поиск и пометка повторяющихся значений

Sub SelectDoubledData()
Dim q As Integer
Dim z As Integer
Dim c As Range
Dim r As Range
    With Selection
        For Each c In Selection
         If Len(c.Value) > 0 Then
          q = 0
          Set c = .Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                Do
                    If c.Row > q Then q = c.Row
                    Set c = .FindNext(c)
                    z = c.Row
                    If z > q Then Cells(c.Row, c.Column + 1).Value = 1
                Loop While c.Row > q
          End If
        Next c
    End With
End Sub

Sub getTheSame()
 On Error GoTo errh:
 Dim h As New Scripting.dictionary
 Dim rg As Range
 Set rg = Columns(2).Cells.SpecialCells(xlCellTypeConstants)
 For Each c In rg.Cells
  DoEvents
  h(c.Value) = h(c.Value) + 1
  If h(c.Value) > 1 Then
   c.Offset(0, 1).Value = "Exists"
  End If
 Next c
 Set h = Nothing
 
 If 0 Then
errh:
  Set h = Nothing
  MsgBox Err.Description
 End If
End Sub

Sub getTheSame()
    On Error GoTo errh: 'Устанавливаем хендлер ошибок
    Dim h As New Scripting.dictionary 'Создаем хеш - множество пар "ключ" -> значение
    Dim rg As Range 
    Set rg = Columns(2).Cells.SpecialCells(xlCellTypeConstants) 'Берем только константы из колонки 2
    For Each c In rg.Cells 'Перебираем все ячейки из множества 
        DoEvents 'Даем Экселю возможность отрисоваться
        ActiveWindow.Caption = c.Address 'Можно еще адрес ячейки показывать - чтоб был виден прогресс
        h(c.Value) = h(c.Value) + 1 ' Если ключ не существовал, хеш его автоматически добавит, иначе увеличит к-во повторений ключа
        If h(c.Value) > 1 Then 'Если ключ встречался более 1 раза
            c.Offset(0, 1).Value = "Exists" 'Ставим в соседней ячейке Exists
        End If
    Next c
    Set h = Nothing 'Освобождаем память из под хеша
    MsgBox "Done", vbInformation' Ну и для наглядности плакат об окончании
    '=============================
    If 0 Then 'Сюда попадем только в случае ошибки
errh:       'В обычных условиях if 0 никогда не сработает
        Set h = Nothing 'Если возникла ошибка - освобождаем память из под хеша
        MsgBox Err.Description 'Выводим сообщение об ошибке
    End If
    '==============================
End Sub