Public Sub DeleteDuplicateRows2()
  Dim xTable As Table, xRow As Range, xStr As String, xDic As Object
  Dim I As Long, J As Long, KK As Long, xNum As Long, iRow As Long, iRows As Long
  Dim aRng As Range, cRng As Range

  'Application.ScreenUpdating = False
  Set xDic = CreateObject("Scripting.Dictionary")
  If Selection.Tables.Count = 0 Then
    MsgBox "Macro must be run when a table is selected"
    Exit Sub
  Else
    Set xTable = Selection.Tables(1)
    iRows = xTable.Rows.Count
    For I = iRows To 3 Step -1
      Set aRng = xTable.Rows(I).Range
      aRng.Start = aRng.Cells(2).Range.Start
      For iRow = 3 To I - 1
        Set cRng = xTable.Rows(iRow).Range
        cRng.Start = cRng.Cells(2).Range.Start
        If aRng.Text = cRng.Text Then
          xTable.Rows(I).Delete
          Exit For
        End If
      Next iRow
    Next I
  End If
  Application.ScreenUpdating = True
End Sub