C
cg
With help from this forum, I found the code below which
works great for my situation except for one thing. The
first item in the dropdown is nothing. I want to force
something to be in this combobox without a choice to have
it blank. Any help would be greatly appreciated.
' This procedure is based on a tip by J.G. Hussey,
' published in "Visual Basic Programmer's Journal"
Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
ufCreate.cbVendor.Clear
Set AllCells = Sheet1.Range("f2:f500")
Set NoDupes = Nothing
' The next statement ignores the error caused
' by attempting to add a duplicate key to the
collection.
' The duplicate is not added - which is just what we
want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method
must be a string
Next Cell
' Resume normal error handling
On Error GoTo 0
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
ufCreate.cbVendor.AddItem Item
Next Item
Set AllCells = Nothing
End Sub
works great for my situation except for one thing. The
first item in the dropdown is nothing. I want to force
something to be in this combobox without a choice to have
it blank. Any help would be greatly appreciated.
' This procedure is based on a tip by J.G. Hussey,
' published in "Visual Basic Programmer's Journal"
Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
ufCreate.cbVendor.Clear
Set AllCells = Sheet1.Range("f2:f500")
Set NoDupes = Nothing
' The next statement ignores the error caused
' by attempting to add a duplicate key to the
collection.
' The duplicate is not added - which is just what we
want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method
must be a string
Next Cell
' Resume normal error handling
On Error GoTo 0
' Sort the collection (optional)
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
' Add the sorted, non-duplicated items to a ListBox
For Each Item In NoDupes
ufCreate.cbVendor.AddItem Item
Next Item
Set AllCells = Nothing
End Sub