skulakowski

06-30-2004, 10:53 AM

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

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