Unique Listbox Scripting Dictionary

[Guest]

I all,
Let me see if i can explain this in a way that will get some help!
I have a userform that has a combo box (A) that is filled when the form
initializes. Depending on what the user selects it then fills the next
combobox (B), my problem arises in that i just want the unique items. No
double entries to fill the combo box.
A B
Grapes Red Flames
Peach Yellow
Grapes Thompsons
Grapes Ruby Reds
Peach White

The following is some of the code:
Private Sub LoadLocation()

With lstFieldLocation
.Clear
Farm = cboFarm.Value
For Index = 2 To source.Rows.Count
If Farm = source.Cells(Index, 1) Then
.AddItem source.Cells(Index, 2) ' Field Location

End If
Next
End With

Dim Locations As New Scripting.Dictionary
For Index = 2 To source.Rows.Count
Loc = source.Cells(Index, "b").Value
If Not Locations.Exists(Loc) Then
Locations.Add Loc, Loc
lstFieldLocation.AddItem Farm
End If
Next
End Sub
Please let me know if you need anything else. Thank you so much, Jennifer

 

[Bob Phillips]

Private Sub LoadLocation()
Dim Farm, Index As Long, Loc
Dim Locations As Object

lstFieldLocation.Clear

Farm = cboFarm.Value

Set Locations = CreateObject("Scripting.Dictionary")
With Source
For Index = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If .Cells(Index, "A").Value = Farm Then
Loc = .Cells(Index, "B").Value
If Not Locations.Exists(Loc) Then
Locations.Add Loc, Loc
lstFieldLocation.AddItem Loc
End If
End If
Next

End With
End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Guest]

Just some added information.
You asked for the scripting dictionary and Bob gave you that. It can also
be done with a built in collection object without the overhead of referencing
the scripting runtime:

Private Sub LoadLocation()
Dim Farm, Index As Long, Loc
Dim Locations As Collection

lstFieldLocation.Clear

Farm = cboFarm.Value

Set Locations = New collection
With Source
For Index = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If .Cells(Index, "A").Value = Farm Then
Loc = .Cells(Index, "B").Value
On Error Resume Next
locations.Add loc, cstr(loc)
if err.Number = 0 then
lstFieldLocation.AddItem Loc
End If
On Error goto 0
End If
Next

End With
End Sub