In Conditional Data Validation and Basing One Listbox on Another, I showed how to based one “control” on another using multiple list. Gerry in the newsgroups wants to do the same thing, but filtering only one list.
I start with a list named NameList showing surname, first name, and date of birth and two comboboxes (cbxSurname and cbxFirstname) and one textbox (tbxDOB).
When the workbook opens, cbxSurname is filled with all the unique surnames in the list.
Dim rCell As Range
Dim rRng As Range
Dim colUniques As Collection
Dim vItm As Variant
‘initialize range and collection
Set rRng = Sheet1.Range(“NameList”).Columns(1)
Set colUniques = New Collection
‘clear the combobox in case we need to call this some
‘other time
Sheet1.cbxSurname.Clear
‘loop through the cells adding them to a collection
‘duplicate keys won’t be added
For Each rCell In rRng.Cells
On Error Resume Next
colUniques.Add rCell.Value, rCell.Value
On Error GoTo 0
Next rCell
‘loop through the collection and add to the combobox
For Each vItm In colUniques
Sheet1.cbxSurname.AddItem vItm
Next vItm
End Sub
When a surname is selected from cbxSurname, the Change event is fired and cbxFirstname is loaded with matching first names.
Dim rFound As Range
Dim rRng As Range
Dim sFirstAdd As String
Me.tbxDOB.Text = “”
Set rRng = Me.Range(“NameList”).Columns(1)
With Me.cbxFirstname
.Clear
Set rFound = rRng.Find(Me.cbxSurname.Text)
If Not rFound Is Nothing Then
sFirstAdd = rFound.Address
Do
.AddItem rFound.Offset(0, 1).Value
Set rFound = rRng.FindNext(rFound)
Loop Until rFound.Address = sFirstAdd
End If
End With
End Sub
Finally, when a first name is selected, the date of birth is put into the textbox.
Dim rFound As Range
Dim rRng As Range
Dim sFirstAdd As String
Me.tbxDOB.Text = “”
Set rRng = Me.Range(“NameList”).Columns(1)
Set rFound = rRng.Find(Me.cbxSurname.Text)
If Not rFound Is Nothing Then
sFirstAdd = rFound.Address
Do
If rFound.Offset(0, 1).Value = Me.cbxFirstname.Text Then
Me.tbxDOB.Text = Format(rFound.Offset(0, 2).Value, “mm/dd/yyyy”)
Else
Set rFound = rRng.FindNext(rFound)
End If
Loop Until rFound.Address = sFirstAdd Or Len(Me.tbxDOB.Text) > 0
End If
End Sub
Will This codw work excel 97.
I think so. I don’t see anything in there that’s new.
Could I replicate this code to use several comboboxes to achieve the unique price of a detailed product, for example?
Like:
brand -> product line -> product type -> product model -> product size -> PRICE
Thanks in advance for any help.
i work in excel 2003
i input that code step by step and the second combobox and text box does not appear anything
why;
thank you
I FOUND MY MISTAKE
SORRY