Удаление повторяющихся имён при помощи макроса

Option Explicit
Const COL_TESTGROUP = 2     'Column "B"
Const COL_TESTDUPLICATE = 1 'Column "A"
Const ROW_FIRSTGROUP = 1    'Row 1
 
Sub DeleteDuplicates()
' Deletes duplicate items within each group on the sheet
' A group is a collection of rows that are separated
' by one or more blank cells in column "A"
' Duplicates are determined by examining the
' contents of column "B"
Dim nGroupLastRow As Long
Dim rng As Range
 
  Set rng = Range(Cells(ROW_FIRSTGROUP, COL_TESTGROUP), _
                  Cells(ROW_FIRSTGROUP, COL_TESTGROUP))
  If Not IsEmpty(rng.Offset(1, 0)) Then
    nGroupLastRow = rng.Cells(1, 1).End(xlDown).Row
    Set rng = Range(Cells(ROW_FIRSTGROUP, COL_TESTGROUP), _
                    Cells(nGroupLastRow, COL_TESTGROUP))
  End If
 
  Call RemoveDups(rng.Offset(0, COL_TESTDUPLICATE - COL_TESTGROUP))
  While NextGroup(rng)
      Call RemoveDups(rng.Offset(0, COL_TESTDUPLICATE - COL_TESTGROUP))
  Wend
  
End Sub
 
Sub RemoveDups(AGroup As Range)
' AGroup is a single column range.
' Rows are deleted when the same value appears in multiple rows.
' The last (highest row number) instance is retained.
Dim nRow As Long
Dim r As Range
  If AGroup.Rows.Count > 1 Then
    Application.ScreenUpdating = False
    With AGroup
      For nRow = .Rows.Count To 2 Step -1
        Set r = Range(.Cells(1, 1), .Cells(nRow - 1, 1)).Find(.Cells(nRow).Value, _
                    .Cells(nRow - 1, 1), xlValues, xlWhole, xlByColumns, xlPrevious)
        If Not r Is Nothing Then
          '.Cells(nRow).EntireRow.Delete
            .Cells(nRow).Offset(COL_TESTDUPLICATE - 1, 0).Clear
        End If
      Next nRow
    End With
    Application.ScreenUpdating = True
  End If
End Sub
 
Private Function NextGroup(ByRef AGroup As Range) As Boolean
' Finds the "next" group below a given group
' A "Group" is a single column range.
' The "next" group starts with the first non-blank
' cell following all blank cells below the
' given range.
Dim nFirstRow As Long
Dim nGroupLastRow As Long
  With AGroup
    nFirstRow = .Cells(.Rows.Count, 1).End(xlDown).Row
  End With
  If nFirstRow >= 65536 Then
    Set AGroup = Nothing
  Else
    If IsEmpty(Cells(nFirstRow + 1, 1)) Then
      Set AGroup = Cells(nFirstRow, 1)
    Else
      nGroupLastRow = Cells(nFirstRow, 1).End(xlDown).Row
      Set AGroup = Range(Cells(nFirstRow, 1), _
                         Cells(nGroupLastRow, 1))
    End If
  End If
  If AGroup Is Nothing Then
    NextGroup = False
  Else
    If IsEmpty(AGroup.Cells(1, 1)) Then
      NextGroup = False
    Else
      NextGroup = True
    End If
  End If
End Function

Sub kill_the_same()
 Dim h As New Scripting.Dictionary, c
  For Each c In Selection.Cells
   If h.Exists(Trim(c.Formula)) Then
    c.Formula = "---"
    Else
    h(Trim(c.Formula)) = 1
   End If
  Next c
 Set h = Nothing
End Sub