Поиск дубликатов в Excel по столбцу с активной ячейкой

Однажды мне понадобилось определить есть ли в том или ином столбце таблицы Excel дубликаты. Поэтому я решил написать код на VBA со следующим алгоритмом:

1. При запуске макроса, происходит определение в каком столбце находится активная ячейка.
2. Происходит определение всех заполненных ячеек в этом столбце.
3. Происходит сравнение значений в ячейках.
4. Если есть совпадение, то цвет заливки ячейки меняется. Причём для каждого уникального совпадения цвет тоже должен быть уникальным. Ведь так будет легче анализировать данные.

Код VBA для сравнения ячеек Excel

Sub Сравнение_ячеек()
    ' Определяем в какой колонке находится активная ячейка
    Dim activeColumn As Integer
    activeColumn = ActiveCell.Column

    ' Определяем последнюю заполненную ячейку в колонке
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, activeColumn).End(xlUp).Row

    ' Сохраняем значение ячеек и их адрес в словаре
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    Dim cell As Range
    Dim cellValue As Variant
    
    ' Создаем список цветов
    Dim colors As Variant
    colors = Array(RGB(255, 255, 0), RGB(144, 238, 144), RGB(173, 216, 230), RGB(255, 182, 193), RGB(255, 165, 0), RGB(221, 160, 221))
    
    Dim colorIndex As Integer
    colorIndex = 0
    
    For Each cell In Range(Cells(1, activeColumn), Cells(lastRow, activeColumn))
        cellValue = cell.Value
        If Not IsEmpty(cellValue) Then
            If dict.exists(cellValue) Then
                dict(cellValue) = dict(cellValue) & "," & cell.Address
            Else
                dict.Add cellValue, cell.Address
            End If
        End If
    Next cell

    ' Выделяем ячейки с одинаковыми значениями разными цветами
    Dim addresses As String
    For Each cellValue In dict.Keys
        addresses = dict(cellValue)
        If InStr(addresses, ",") > 0 Then ' Перевірка, чи є дублікати
            Range(addresses).Interior.Color = colors(colorIndex Mod (UBound(colors) + 1))
            colorIndex = colorIndex + 1
        End If
    Next cellValue
End Sub