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

[spazmonkey]

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

 

[erik.van.geit]

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

 

[spazmonkey]

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

 

[Norie]

Something like this?

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

 

[spazmonkey]

Thanks Norrie. Will try the code now.

 

[erik.van.geit]

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
	A	B	C	D	E	F	G	H	I
1	Country	Town	Surname	First Name		Country	Town	Surname	First Name
2	England	London	Smith	John		England	London	Smith	John
3	England	London	Smith	Maggie		Belgium	Bruxelles	James	Maggie
4	Belgium	Bruxelles	Smith	John			Manchester		Felix
5	England	Manchester	Smith	John			Antwerp		Brian
6	Belgium	Antwerp	Smith	John			Brugge
7	Belgium	Bruxelles	James	John
8	Belgium	Brugge	James	John		lists produced at runtime
9	England	London	James	Felix
10	England	London	James	Brian
11
12	comboboxsources
13	available
14	selected
15	auto-selected
ComboInfo

possible enhancements:
disable boxes till choise is allowed
erase unique lists

'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

 

[manon]

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.

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?

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

 

[erik.van.geit]

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

 

[JONESY]

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

 

[jindon]

JONESY
Here's another approach

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