Sortering og sletning af data

Prøv dette spm.

http://www.eksperten.dk/spm/459663

kør fx den øverste makro her. hvis navne ikke står i kolonne A så juster dette

Sub test_delete_dups()
  Dim Rng1 As Range
  Set Rng1 = Range(Range("A2"), Range("A65536").End(xlUp))
  RemoveDuplicates Rng1, True
End Sub

Private Sub RemoveDuplicates(rList As Range, bDeleteEntireRow As Boolean)
'if bDeleteEntireRow = true then delete entire row else delete only cells and shift up
  Dim Cell As Range
  Dim Uniqs As New Dictionary
  Dim oldCalc As Long

  'Initialize
  Application.ScreenUpdating = False
  oldCalc = Application.Calculation
  Application.Calculation = xlCalculationManual

  'Find uniq values and do empty all cells with duplicates
  On Error Resume Next
  For Each Cell In rList
      Uniqs.Add Cell.Value, CStr(Cell.Value)
      If Err.Number <> 0 Then Cell = Null
      Err.Clear
  Next Cell

  'Find (select) empty cells and delete entire row
  rList.SpecialCells(xlCellTypeBlanks).Select
  If bDeleteEntireRow = True Then
      Selection.EntireRow.Delete Shift:=xlUp
  Else
      Selection.Cells.Delete Shift:=xlUp
  End If
  'Cleanup
  Application.Calculation = oldCalc
  Application.ScreenUpdating = True
  Set Uniqs = Nothing
End Sub

du skal lige ændre denne linie
Dim Uniqs As New Dictionary

til

Dim Uniqs As New Collection