populate list/combobox without duplicates

[ulfal029]

I have a huge list with items from which I extract and populate a combobox. Two issues:

1. Is there a way to remove duplicates without looping through the already added items within the combobox? I've tried but it's *really* slow.

2. When the combobox is populated, can the added items be sorted in aplhabetic order?

Thanks for yor help!

[Kenneth Hobs]

Put the first sub in your userform. Put the functions in a module or make them Privale and put in your userform.

Private Sub UserForm_Initialize()
Dim e As Variant
For Each e In SortArray(UniqueValues(Sheet1.Range("A1:F9")))
ComboBox1.AddItem e
Next e
End Sub

'Similar to, http://vbaexpress.com/forum/showthread.php?t=21265
Function SortArray(ByRef MyArray As Variant, Optional Order As Long = xlAscending) As Variant
Dim w As Worksheet
Dim r As Range

Set w = ThisWorkbook.Worksheets.Add()

On Error Resume Next
Range("A1").Resize(UBound(MyArray, 1), 1) = WorksheetFunction.Transpose(MyArray)
Range("A1").Resize(UBound(MyArray, 1), UBound(MyArray, 2)) = WorksheetFunction.Transpose(MyArray)
Set r = w.UsedRange
If Order = xlAscending Then
r.Sort Key1:=r.Cells(1, 1), Order1:=xlAscending
Else
r.Sort Key1:=r.Cells(1, 1), Order1:=xlDescending
End If

SortArray = r

Set r = Nothing
Application.DisplayAlerts = False
w.Delete
Application.DisplayAlerts = True
Set w = Nothing
End Function

'http://www.mrexcel.com/forum/showthread.php?t=329212
Public Function UniqueValues(theRange As Range) As Variant
Dim colUniques As New VBA.Collection
Dim vArr As Variant
Dim vCell As Variant
Dim vLcell As Variant
Dim oRng As Excel.Range
Dim i As Long
Dim vUnique As Variant
Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
vArr = oRng
On Error Resume Next
For Each vCell In vArr
If vCell <> vLcell Then
If Len(CStr(vCell)) > 0 Then
colUniques.Add vCell, CStr(vCell)
End If
End If
vLcell = vCell
Next vCell
On Error GoTo 0

ReDim vUnique(1 To colUniques.Count)
For i = LBound(vUnique) To UBound(vUnique)
vUnique(i) = colUniques(i)
Next i

UniqueValues = vUnique
End Function

[ulfal029]

I'll try this, by the look of it seems like it'll work.

[johnshepherd]

Great solution Kenneth! Thanks.

Should definitely be marked as "Solved:"