find identical names in list
'Mark aktual colum, run sub
Sub SletDubletter()
Dim c, r, t, t2
c = ActiveCell.Column
r = Cells(65500, c).End(xlUp).Row
Range(Cells(1, c), Cells(65500, c).End(xlUp)).Select
For t = 1 To r
If Cells(t, c) < "" Then
For t2 = t + 1 To r
If Cells(t, c) = Cells(t2, c) Then
Cells(t2, c) = ""
End If
Next
End If
Next
Selection.Sort Key1:=Range(ActiveCell.Address), Order1:=xlAscending
ActiveCell.Select
End Sub
|