filtering out duplicate data values

[vbRookie07]

can someone help me modify this code so that my combobox filters out
duplicate values?

Private Sub UserForm_Initialize()
Dim ListStates As Variant, i As Integer
Dim SourceWB As Workbook

With Me.cboState
.Clear ' remove existing entries from the listbox
' turn screen updating off,
' prevent seeing source workbook being opened
Application.ScreenUpdating = False
' open source workbook as ReadOnly
Set SourceWB = Workbooks.Open("H:\Project Tracking db\FY08 Per
Diem Rates.xls", _
False, True)
ListStates = SourceWB.Worksheets(1).Range("A4:A666").Value
' get values
SourceWB.Close False ' close source workbook without saving
Set SourceWB = Nothing
ListStates =
Application.WorksheetFunction.Transpose(ListStates)
' convert values to a vertical array
For i = 1 To UBound(ListStates)
.AddItem ListStates(i) ' populate the listbox
Next i
.ListIndex = -1 ' no items selected, set to 0 to select the
first item
Application.ScreenUpdating = True
End With
End Sub

 

[Guest]

One method of filtering out the duplicates is to use a collection. Items in
a collection cannot have the same "key", so you can temporarily disable error
handling, add all of the values to the collection (using the value as it's
own "key"), then add your collection of unique values to the listbox. An
example using some dummy data I set up in A1:A8 on my end:

Sub test()
Dim v As Variant
Dim colUnique As Collection
Dim i As Long

Set colUnique = New Collection
v = Application.Transpose(Range("A1:A8").Value)

On Error Resume Next
For i = LBound(v) To UBound(v)
colUnique.Add v(i), CStr(v(i))
Next i
On Error GoTo 0

For i = 1 To colUnique.Count
MsgBox colUnique(i)
'Add values to Listbox
Next i

End Sub

 

[Guest]

Tyr this:
Private Sub UserForm_Initialize()

Dim ListStates As Variant, i As Integer

Dim SourceWB As Workbook



With Me.cboState

.Clear ' remove existing entries from the listbox

' turn screen updating off,

' prevent seeing source workbook being opened

Application.ScreenUpdating = False

' open source workbook as ReadOnly

Set SourceWB = Workbooks.Open("H:\Project Tracking db\FY08 Per

Diem Rates.xls", _

False, True)

SourceWB.Worksheets(1).Range("A4:A666").AdvancedFilter
xlFilterInPlace
ListStates = SourceWB.Worksheets(1).Range("A4:A666").Value

' get values

SourceWB.Close False ' close source workbook without saving

Set SourceWB = Nothing

ListStates =

Application.WorksheetFunction.Transpose(ListStates)

' convert values to a vertical array

For i = 1 To UBound(ListStates)

.AddItem ListStates(i) ' populate the listbox

Next i

.ListIndex = -1 ' no items selected, set to 0 to select the

first item

Application.ScreenUpdating = True

End With