Excel User Form... Filter Combo box based on other

spazmonkey

New Member
Joined
Dec 9, 2004
Messages
40
I am trying to create an excel user form.

The form consists of 3 or 4 combo boxes and a few text boxes.

There are two worksheets "Data" and "ComboInfo".

Worksheet "ComboInfo" has 4 columns to represent the drop-down data.

I want the user to select a value in combo1. This will then repopulate and filter the list in combo2 with rows that matching combo1. I want to repeat the process for the other combo boxes.

Once the combo boxes are completed and a few additional textboxes the data needs to applied to the "Data" worksheet.

My main stumbling block is Filtering the Combo2.AddItem.

Any advice would be gratefully appreciated
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Hi, spazmonkey,

This will then repopulate and filter the list in combo2 with rows that matching combo1,

please elaborate the conditions
can you give some sample data ...

kind regards,
Erik
 
Upvote 0
Hi Eric,

Worksheet with some sample data

ComboInfo

Combo1 Data/Combo2 Data/Combo3 Data/Combo4 Data

Country /Town /Surname /First Name

England ;London ;Smith ;John
England ;London ;Smith ;Maggie
Belgium ;Bruxelles ;Smith ;John
England ;Manchester ;Smith ;John


If Combo1 = England I want Combo2 to contain "London" and "Manchester"


If Combo1 = England and Combo2 = London I would like Combo3 to contain "Smith"


I am hoping to use a variation on the following Form Initialisation code.

Dim i As Long, j As Long
Dim ws As Worksheet
Set ws = Worksheets("ComboInfo")
With frmRecruitmentQuality
For j = 1 To 4
For i = 1 To ws.Cells(65536, j).End(xlUp).Row
Select Case j
Case 1
.ComboBox1.AddItem ws.Cells(i, j)
Case 2
.ComboBox2.AddItem ws.Cells(i, j)
Case 3
.ComboBox3.AddItem ws.Cells(i, j)
Case 4
.ComboBox4.AddItem ws.Cells(i, j)
End Select
Next
Next
End With



Hope you can help
 
Upvote 0
Something like this?
Code:
Private Sub ComboBox1_Change()
Dim I As Long
Dim ws As Worksheet

    Set ws = Worksheets("ComboInfo")
    ComboBox2.Clear
    For I = 1 To ws.Cells(65536, 1).End(xlUp).Row
        If ws.Cells(I, 1) = ComboBox1.Value Then
            ComboBox2.AddItem ws.Cells(I, 2)
        End If
    Next I
End Sub
Private Sub ComboBox2_Change()
Dim I As Long
Dim ws As Worksheet

    Set ws = Worksheets("ComboInfo")
    ComboBox3.Clear
    For I = 1 To ws.Cells(65536, 1).End(xlUp).Row
        If ws.Cells(I, 2) = ComboBox2.Value Then
            ComboBox3.AddItem ws.Cells(I, 3)
        End If
    Next I
End Sub

Private Sub ComboBox3_Change()
Dim I As Long
Dim ws As Worksheet

    Set ws = Worksheets("ComboInfo")
    ComboBox4.Clear
    For I = 1 To ws.Cells(65536, 1).End(xlUp).Row
        If ws.Cells(I, 3) = ComboBox3.Value Then
            ComboBox4.AddItem ws.Cells(I, 4)
        End If
    Next I
End Sub
 
Upvote 0
Hi, guys,

When the lists contain duplicates it would be nice to display only the uniques.
When there is only a single choise in the next box, it will be selected automatically.

loading userform will produce new unique lists at the right
choosing first item will autofilter

Changing box 1 will erase 2 to 4.
Changing box 2 will erase 3 and 4.
Changing box 3 will erase 4.

code can be ran with any activesheet
can be easily expanded to more lists = comboboxes

I tried to figure out an example to make clear what happens.
Map1.xls
ABCDEFGHI
1CountryTownSurnameFirst NameCountryTownSurnameFirst Name
2EnglandLondonSmithJohnEnglandLondonSmithJohn
3EnglandLondonSmithMaggieBelgiumBruxellesJamesMaggie
4BelgiumBruxellesSmithJohnManchesterFelix
5EnglandManchesterSmithJohnAntwerpBrian
6BelgiumAntwerpSmithJohnBrugge
7BelgiumBruxellesJamesJohn
8BelgiumBruggeJamesJohnlists produced at runtime
9EnglandLondonJamesFelix
10EnglandLondonJamesBrian
11
12comboboxsources
13available
14selected
15auto-selected
ComboInfo

possible enhancements:
disable boxes till choise is allowed
erase unique lists
Code:
'Erik Van Geit
'050618

'cascading comboboxes :-)
'sources in corresponding columns
  'box1 = column1 ...
'several comboboxes (see N)
  'to expand:
    'add combobox on userform
    'Const N = number of boxes
    'add Private Sub ComboBox ..N.. _Change()
Option Explicit

Const N = 4
Public flag As Boolean

Private Sub ComboBox1_Change()
If flag = True Then Exit Sub
update_comboboxes (1)
'general syntax
'update_comboboxes (Application.WorksheetFunction.Substitute(ActiveControl.Name,ComboBox,))
End Sub
Private Sub ComboBox2_Change()
If flag = True Then Exit Sub
update_comboboxes (2)
End Sub
Private Sub ComboBox3_Change()
If flag = True Then Exit Sub
update_comboboxes (3)
End Sub

Sub update_comboboxes(nr As Integer)
Dim I As Long
Dim ws As Worksheet
Dim FilterRng As Range
Dim UniqueRng As Range
Dim cell As Range

Set ws = Worksheets("ComboInfo")

flag = True
    For I = nr + 1 To N
    Controls("ComboBox" & I).Clear
    Next I
ws.Cells.AutoFilter
Set UniqueRng = ws.Range(ws.Cells(2, N + nr + 2), ws.Cells(65536, N + nr + 2).End(xlUp))

  For I = 1 To nr
  ws.Columns(1).Resize(Rows.Count, N).AutoFilter Field:=I, Criteria1:=Controls("ComboBox" & I).Value
  Next I

Set FilterRng = ws.Range(ws.Cells(2, nr + 1), ws.Cells(65536, nr + 1).End(xlUp)).SpecialCells(xlCellTypeVisible)

    For Each cell In UniqueRng
        If Not FilterRng.Find(cell) Is Nothing Then
        I = I + 1
        Controls("ComboBox" & nr + 1).AddItem cell
        End If
    Next cell
flag = False

If Controls("ComboBox" & nr + 1).ListCount = 1 Then
Controls("ComboBox" & nr + 1) = Controls("ComboBox" & nr + 1).List(0)
End If
End Sub

Private Sub userform_initialize()
Dim I As Integer
Dim LR As Long
Dim ws As Worksheet

Set ws = Worksheets("ComboInfo")

ws.Columns(N + 1).Resize(Rows.Count, N).ClearContents

For I = 1 To N
LR = ws.Cells(65536, I).End(xlUp).Row
ws.Range(ws.Cells(1, I), ws.Cells(LR, I)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, N + I + 1), Unique:=True
Next I

LR = ws.Cells(65536, N + 2).End(xlUp).Row
Controls("ComboBox1").RowSource = ws.Name & "!" & Range(ws.Cells(2, N + 2), ws.Cells(LR, N + 2)).Address(0, 0)
    
End Sub

kind regards,
Erik
 
Upvote 0
Changes to cascading comboboxes code

Hi Erik,
the code below on cascading comboboxes is great and getting close to what I need. I have tried to make it suit my needs and I managed to do some of it but some things I cannot get to work.

I have added the following pieces of code to make the user form appear every time the user selects the first worksheet, called InputForm. When the user clicks "Show selection" the second sheet appears where the selection is visible.
Code:
Private Sub Worksheet_Activate()
UserForm1.Show
End Sub

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Worksheets("ComboInfo").Activate
UserForm1.Hide
Range("A1").Select
End Sub

In your code loading the userform will produce a new unique list at the right. I would like to have this list on another (hidden) sheet. Is this possible?

On the results sheet I would like to hide the AutoFilter drop downs. I tried to do this with the following line but it only seems to work every now and then. Do you have any other suggestions?
Code:
Worksheets("ComboInfo").AutoFilterMode = False

If I only enter a selection in the first and/or second box on the user form and go to the result sheet is it possible to make the following column sorted ascending?

Thanks in advance for your help.

Best regards,
Manon
 
Upvote 0
Hi, Manon,

the bold part is telling where to put the filtered list
just change to your sheet (using variable)
ws.Range(ws.Cells(1, i), ws.Cells(LR, i)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Cells(1, N + i + 1), Unique:=True

On the results sheet I would like to hide the AutoFilter drop downs.
this is not py speciality: in the helpfiles you find that the property AutoFilterMode is dependent of FilterMode

If I only enter a selection in the first and/or second box on the user form and go to the result sheet is it possible to make the following column sorted ascending?
not sure if I understand you here, can you provide an example ? (I feel this is not related to the combobox-thing itself OR ?)

kind regards,
Erik
 
Upvote 0
Hi Guys

Sorry to interject. Really like the combo box drop downs Eric. When I applied the code I get more drop down data choices in Combo box 2 than there should be for the filtered data. Any ideas

L
 
Upvote 0
JONESY
Here's another approach
Code:
Private r As Range, dic As Object

Private Sub userform_initialize()
Dim x
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("ComboInfo")
    For Each r In .Range("a2", .Range("a65536").End(xlUp))
        If Not IsEmpty(r) And Not dic.exists(r.Value) Then
            dic.Add r.Value, Nothing
        End If
    Next
End With
x = dic.keys
Me.ComboBox1.List = x
End Sub

Private Sub ComboBox1_Change()
Me.ComboBox2.Clear: Me.ComboBox2.Clear
Set dic = CreateObject("Scripting.dictionary")
    With Sheets("ComboInfo")
        For Each r In .Range("a2", .Range("a65536").End(xlUp))
            If r = Me.ComboBox1.Value Then
                If Not dic.exists(r.Offset(, 1).Value) Then
                    Me.ComboBox2.AddItem r.Offset(, 1)
                    dic.Add r.Offset(, 1).Value, Nothing
                End If
            End If
        Next
    End With
    With Me.ComboBox2
        If .ListCount = 1 Then .ListIndex = 0
    End With
End Sub

Private Sub ComboBox2_Change()
Dim x
Me.ComboBox3.Clear
With Sheets("ComboInfo")
    For Each r In .Range("a2", .Range("a65536").End(xlUp))
        If r = Me.ComboBox1.Value And r.Offset(, 1) = Me.ComboBox2.Value Then
            x = r.Offset(, 2) & Chr(32) & r.Offset(, 3)
                Me.ComboBox3.AddItem x
        End If
    Next
End With
With Me.ComboBox3
    If .ListCount = 1 Then .ListIndex = 0
End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,914
Messages
6,175,351
Members
452,638
Latest member
Oluwabukunmi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top