I've got long, long lists of labels from which I want only the unique labels.

Right now I'm sorting the initial list; setting duplicates to the value of 'z'; resorting; and then resetting my counter to the position of the last unique label. It's surely not the most efficient method of eliminating dups and sorting but it works very well for short lists.

However, the 'bubble sort' I'm using (from Walkenbach's VBA book) does not work well for long, long lists. The other two faster sorts he offers handle numbers but not alpha strings.

Anybody have a faster VBA sort for alphas? or a better way to eliminate the duplicates and sort the remaining unique labels? Thanks.


'iLastRow is counter that represents the total number of unsorted entries
'FYI, data starts in row 2, not row 1, hence the iLastRow - 1 for the counter
ReDim list(0 To iLastRow - 1) As String
'read spreadsheet column data into array
For p = 0 To iLastRow - 1
    list(p) = ActiveCell.Offset(p, 0).value
Next p
'this is the first sort
First = LBound(list)
Last = UBound(list)
For q = First To Last - 1
    For j = q + 1 To Last - 1
        If list(q) > list(j) Then
            Temp = list(j)
            list(j) = list(q)
            list(q) = Temp
        End If
    Next j
Next q
'Set duplicates to z
For q = First To Last
    For j = q + 1 To Last - 1
        If list(q) = list(j) Then
            list(j) = "z"
        End If
    Next j
Next q
'Resort z's to bottom
For q = First To Last - 1
    For j = q + 1 To Last - 1
        If list(q) > list(j) Then
            Temp = list(j)
            list(j) = list(q)
            list(q) = Temp
        End If
    Next j
Next q
'Reset the value of j for complete list WITHOUT DUPS
For q = First To Last - 1
    If list(q) <> "z" Then j = q
Next q
'Goto the correct position to write out unique labels
'Write out unique labels
For q = 0 To j
    ActiveCell.Offset(q, 0) = list(q)
Next q