Just paste this code into any module and change the name of the module to basArrays.
'----------------------------------------------------------------------
'
' Module Name: basArrays
' Written By: C&D Programming Corp.
' Create Date: 2/21/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Public Sub RemoveDuplicates(vList As Variant)
Dim sItem As String
Dim x As Long
Dim y As Long
On Error Goto Handler
Select Case TypeName(vList)
Case "ListBox"
Dim lst As ListBox
' For speed. If we know what type we are
' looking at things will run faster.
Set lst = vList
' if we have one or less items in our list
' there can not be any duplicates.
If lst.ListCount <= 1 Then
Exit Sub
End If
x = -1
While x < lst.ListCount - 1
x = x + 1
sItem = lst.List(x) ' faster this way
For y = lst.ListCount - 1 To x + 1 Step -1
If sItem = lst.List(y) Then
lst.RemoveItem y
End If
Next
Wend
Case "Variant()", "String()"
Dim vTemp As Variant
Dim lLowerBound As Long
Dim lUpperBound As Long
' if we have an empty array there can't be any
' duplicates...
If IsEmpty(vList) Then
Exit Sub
End If
lLowerBound = LBound(vList)
lUpperBound = UBound(vList)
' if we have one or less items in our list
' there can not be any duplicates.
If lUpperBound - lLowerBound <= 0 Then
Exit Sub
End If
' search through the array and null out the
' duplicate values.
x = lLowerBound - 1
While x < lUpperBound
x = x + 1
If vList(x) <> vbNullString Then
sItem = vList(x) ' faster this way
For y = lUpperBound To x + 1 Step -1
If sItem = vList(y) Then
vList(y) = vbNullString
End If
Next
End If
Wend
' create temporary array to manage unique values
ReDim vTemp(lLowerBound To lUpperBound)
' copy all the unique values to a new
' temporary array
y = lLowerBound - 1
For x = lLowerBound To lUpperBound
If vList(x) <> vbNullString Then
y = y + 1
vTemp(y) = vList(x)
End If
Next
' y is the new upper bound, so resize the
' unique array. erase the old array and
' resize it. Then assign the temporary
' array to the original array.
ReDim Preserve vTemp(lLowerBound To y)
Erase vList
ReDim vList(lLowerBound To y)
' If it is a string array we have to copy each
' element individually. If it is a variant
' array we can just assign it to the new variant.
' this is one of the cool things about variants.
' Too bad there is a fair amount of overhead
' involved when using variants.
If TypeName(vList) = "String()" Then
For x = lLowerBound To y
vList(x) = vTemp(x)
Next
Else
vList = vTemp
End If
Erase vTemp
End Select
Exit Sub
Handler:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub