Populate and use ComboBoxes like filters

[chowee21]

Alright, this one should be a good one and hope someone can help me out there....

See the above picture...

I want a way to be able to populate the data on the left into the comboBoxes in a userform on the right.

Here's the fun part... I want to then use the comboBoxes to "filter" the selection. So when the I change the 'Animal', the 'Color' and 'Adult', it will filter and will only show unique values that are left. (i.e. if black is listed 4 times, it will only show it once).

The form will function like filter, but will be more user friendly.

I will then return the ID number of the configurated animal to cell F2. (i was going to use concatenate and a vlookup to do this in excel... so that's not the important one issue)

So for example... if i choose "Dog" under "Animal"... when i click on the "Color" drop box, i should only see "Black", "Yellow" and "White" since yellow is not a dog color.

 

[apo]

Using the same sheet layout you show (although i call it sheet1.. so change that in the code..) and using same Userform..

Add this code to your Userform..

Private Sub ComboBox1_Click()
    Dim x0, it
    With Range("A3:D" & Range("D" & Rows.Count).End(xlUp).Row)
        .AutoFilter 2, ComboBox1.Value
    End With
    With CreateObject("scripting.dictionary")
        For Each it In Range("C4:C" & Range("C" & Rows.Count).End(xlUp).Row).SpecialCells(12)
            x0 = .Item(it.Value)
        Next
        ComboBox2.List = .keys
    End With
End Sub


Private Sub ComboBox2_Click()
    Dim x0, it
    With Range("A3:D" & Range("D" & Rows.Count).End(xlUp).Row)
        .AutoFilter 3, ComboBox2.Value
    End With
    With CreateObject("scripting.dictionary")
        For Each it In Range("D4:D" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(12)
            x0 = .Item(it.Value)
        Next
        ComboBox3.List = .keys
    End With
End Sub


Private Sub ComboBox3_Click()
    With Range("A3:D" & Range("D" & Rows.Count).End(xlUp).Row)
        .AutoFilter 4, ComboBox3.Value
    End With
End Sub


Private Sub CommandButton1_Click()
    With Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
        Range("F2").Value = .Offset(1).SpecialCells(12)
    End With
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
End Sub


Private Sub UserForm_Initialize()
    Dim x0, it
    With CreateObject("scripting.dictionary")
        For Each it In Range("B4:B" & Range("B" & Rows.Count).End(xlUp).Row)
            x0 = .Item(it.Value)
        Next
        ComboBox1.List = .keys
    End With
End Sub

 

[chowee21]

Works very well and i have scaled it up to 8 columns.... for some reason when i try to pull the first record (ID Number 1).. when it gets to the comboBox 7.click() to populate the filtered items for comboBox 8... it will not populate correctly. it loops through and puts all of the heading names and the filtered names as well into combobox8... I have narrowed it down that something in the underlined portion is the issue....and this ONLY happens when i try to pull the FIRST record, any other record it works fine..

Private Sub ComboBox7_Click()
    Dim x0, it
        With Range("A1:H" & Range("H" & Rows.Count).End(xlUp).Row)
            .AutoFilter 7, ComboBox7.Value
        End With
    If ComboBox8.Visible = True Then
[U]        With CreateObject("scripting.dictionary")
            For Each it In Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                x0 = .Item(it.Value)
            Next
            ComboBox8.List = .keys
        End With[/U]
        
        ComboBox8.Enabled = True
    End If
    ComboBox7.Enabled = False
End Sub

 

[chowee21]

Okay, I have determined the situation when it will error out but i cant repeat it on the smaller "Pets" sheet above...

if you remove all records and leave only 1, then it will error out....

After you filter your first column the second one will then populate the combobox with the headings and the current filtered sections. What can i do to fix this?

 

[chowee21]

I sure am blowing up my own thread...

Private Sub UserForm_Initialize()

    
            Me.ComboBox1.AddItem "BEGIN"
    
    'hide all labels and comboboxes
    Label2.Visible = False
    Label3.Visible = False
    Label4.Visible = False
    Label5.Visible = False
    Label6.Visible = False
    Label7.Visible = False
    Label8.Visible = False
    ComboBox2.Visible = False
    ComboBox3.Visible = False
    ComboBox4.Visible = False
    ComboBox5.Visible = False
    ComboBox6.Visible = False
    ComboBox7.Visible = False
    ComboBox8.Visible = False
    
    
End Sub

Private Sub ComboBox1_Change()
    Dim x0, it
    ComboBox2.Enabled = True
    ComboBox3.Enabled = False
    ComboBox4.Enabled = False
    ComboBox5.Enabled = False
    ComboBox6.Enabled = False
    ComboBox7.Enabled = False
    ComboBox8.Enabled = False
    ComboBox2.Value = ""
    ComboBox3.Value = ""
    ComboBox4.Value = ""
    ComboBox5.Value = ""
    ComboBox6.Value = ""
    ComboBox7.Value = ""
    ComboBox8.Value = ""
    Label2.Visible = False
    Label3.Visible = False
    Label4.Visible = False
    Label5.Visible = False
    Label6.Visible = False
    Label7.Visible = False
    Label8.Visible = False
    ComboBox2.Visible = False
    ComboBox3.Visible = False
    ComboBox4.Visible = False
    ComboBox5.Visible = False
    ComboBox6.Visible = False
    ComboBox7.Visible = False
    ComboBox8.Visible = False
    
    'Define which animal is selected
    animal = ComboBox1.Value
    
    'if none selected, end program
If animal = "Select " Then
    Exit Sub
Else
    'make the selected animal's list sheet active
    Worksheets(animal).Activate
        
            With ActiveSheet
                    .AutoFilterMode = False
                    .Range("a:j").AutoFilter
            End With
        
    'return unique values for first variable to ComboBox 2
    With CreateObject("scripting.dictionary")
        For Each it In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
            x0 = .Item(it.Value)
        Next
        ComboBox2.List = .keys
    End With
            'assign headings from excel sheets to the labels
            Label2.Caption = Worksheets(animal).Cells(1, 2).Value
            Label3.Caption = Worksheets(animal).Cells(1, 3).Value
            Label4.Caption = Worksheets(animal).Cells(1, 4).Value
            Label5.Caption = Worksheets(animal).Cells(1, 5).Value
            Label6.Caption = Worksheets(animal).Cells(1, 6).Value
            Label7.Caption = Worksheets(animal).Cells(1, 7).Value
            Label8.Caption = Worksheets(animal).Cells(1, 8).Value
        
        'determine how many variables the selected animal has
        Select Case animal
        Case "Select "
            Exit Sub
        Case "BEGIN"
            'for each variable, show 1 combo box and 1 label.
            ComboBox2.Visible = True
            ComboBox3.Visible = True
            ComboBox4.Visible = True
            ComboBox5.Visible = True
            ComboBox6.Visible = True
            ComboBox7.Visible = True
            ComboBox8.Visible = True
            Label2.Visible = True
            Label3.Visible = True
            Label4.Visible = True
            Label5.Visible = True
            Label6.Visible = True
            Label7.Visible = True
            Label8.Visible = True
    End Select
End If
End Sub



Private Sub ComboBox2_Click()
    'this sub populates the combobox with unique values
    'If the next combobox is visible, filter based on current box and populate nexted box with avalible options
    
        Dim x0, it
        
        
            With Range("A1:H" & Range("H" & Rows.Count).End(xlUp).Row)
                .AutoFilter 2, ComboBox2.Value
            End With
            
        If ComboBox3.Visible = True Then
            With CreateObject("scripting.dictionary")
                For Each it In Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                    x0 = .Item(it.Value)
                Next
                ComboBox3.List = .keys
            End With
            ComboBox3.Enabled = True
        End If
            ComboBox2.Enabled = False
            
End Sub
Private Sub ComboBox3_Click()
    'this sub populates the combobox with unique values
    'If the next combobox is visible, filter based on current box and populate nexted box with avalible options
    Dim x0, it
    
    
        With Range("A1:H" & Range("H" & Rows.Count).End(xlUp).Row)
            .AutoFilter 3, ComboBox3.Value
        End With
    If ComboBox4.Visible = True Then
        With CreateObject("scripting.dictionary")
            For Each it In Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                x0 = .Item(it.Value)
            Next
            ComboBox4.List = .keys
        End With
        
        ComboBox4.Enabled = True
    End If
    ComboBox3.Enabled = False
    
    
    End Sub
Private Sub ComboBox4_Click()
    'this sub populates the combobox with unique values
    'If the next combobox is visible, filter based on current box and populate nexted box with avalible options
    Dim x0, it
    
    
        With Range("A1:H" & Range("H" & Rows.Count).End(xlUp).Row)
            .AutoFilter 4, ComboBox4.Value
        End With
    If ComboBox5.Visible = True Then
        With CreateObject("scripting.dictionary")
            For Each it In Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                x0 = .Item(it.Value)
            Next
            ComboBox5.List = .keys
        End With
        
        ComboBox5.Enabled = True
    End If
    ComboBox4.Enabled = False
    
    
End Sub
Private Sub ComboBox5_Click()
    'this sub populates the combobox with unique values
    'If the next combobox is visible, filter based on current box and populate nexted box with avalible options
    Dim x0, it
    
    
        With Range("A1:H" & Range("H" & Rows.Count).End(xlUp).Row)
            .AutoFilter 5, ComboBox5.Value
        End With
    If ComboBox6.Visible = True Then
        With CreateObject("scripting.dictionary")
            For Each it In Range("F2:F" & Range("F" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                x0 = .Item(it.Value)
            Next
            ComboBox6.List = .keys
        End With
        
        ComboBox6.Enabled = True
    End If
    ComboBox5.Enabled = False
    
End Sub

Private Sub ComboBox6_Click()
    'this sub populates the combobox with unique values
    'If the next combobox is visible, filter based on current box and populate nexted box with avalible options
    Dim x0, it
    
    
        With Range("A1:H" & Range("H" & Rows.Count).End(xlUp).Row)
            .AutoFilter 6, ComboBox6.Value
        End With
    If ComboBox7.Visible = True Then
        With CreateObject("scripting.dictionary")
            For Each it In Range("G2:G" & Range("G" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                x0 = .Item(it.Value)
            Next
            ComboBox7.List = .keys
        End With
        
        ComboBox7.Enabled = True
    End If
    ComboBox6.Enabled = False
    
End Sub

Private Sub ComboBox7_Click()
    'this sub populates the combobox with unique values
    'If the next combobox is visible, filter based on current box and populate nexted box with avalible options
    Dim x0, it
    
        With Range("A1:H" & Range("H" & Rows.Count).End(xlUp).Row)
            .AutoFilter 7, ComboBox7.Value
        End With
    If ComboBox8.Visible = True Then
        With CreateObject("scripting.dictionary")
            For Each it In Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row).SpecialCells(12)
                x0 = .Item(it.Value)
            Next
            ComboBox8.List = .keys
        End With
        
        ComboBox8.Enabled = True
    End If
    ComboBox7.Enabled = False
    
End Sub

Private Sub ComboBox8_Click()
    'this sub populates the combobox with unique values

    
    With Range("A2:H" & Range("H" & Rows.Count).End(xlUp).Row)
        .AutoFilter 8, ComboBox8.Value
    End With
    ComboBox8.Enabled = False
    
    
End Sub


Private Sub CommandButton1_Click()
Dim animal As String
Dim ctl As Control

animal = ComboBox1.Value

'check to verify all fields are filled out, if not, give an error
For Each ctl In UserForm1.Controls
    If TypeOf ctl Is ComboBox Then
        If ctl.Visible = True Then
            If ctl.Text = "" Then
                MsgBox ("Please fill out all fields")
                Exit Sub
            End If
        End If
    End If
Next

        
            'look up index number based off configured selections based on
            Select Case animal
            Case "BEGIN"
            
                    With Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
                        Worksheets(animal).Cells(1, 10).Value = .Offset(1).SpecialCells(12)
                    End With
                If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False

            Case Else
            MsgBox ("No animal selected")
            End Select
            
            
            Unload Me
            
End Sub

Private Sub reset_Click()
    Dim x0, it
    Dim myWorkSheet As String
    'remove any filters on the active page
    If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilterMode = False
    End If
    'clear all ComboBoxes & hide all boxes
    ComboBox2.Enabled = True
    ComboBox3.Enabled = False
    ComboBox4.Enabled = False
    ComboBox5.Enabled = False
    ComboBox6.Enabled = False
    ComboBox7.Enabled = False
    ComboBox8.Enabled = False
    ComboBox1.Value = "BEGIN"
    ComboBox2.Value = ""
    ComboBox3.Value = ""
    ComboBox4.Value = ""
    ComboBox5.Value = ""
    ComboBox6.Value = ""
    ComboBox7.Value = ""
    ComboBox8.Value = ""
    Label2.Visible = False
    Label3.Visible = False
    Label4.Visible = False
    Label5.Visible = False
    Label6.Visible = False
    Label7.Visible = False
    Label8.Visible = False
    ComboBox2.Visible = False
    ComboBox3.Visible = False
    ComboBox4.Visible = False
    ComboBox5.Visible = False
    ComboBox6.Visible = False
    ComboBox7.Visible = False
    ComboBox8.Visible = False
    
End Sub

Please see problem explanation video here:

1111 - YouTube

As stated... I can get it to filter down any line item EXCEPT for ROW 2. What can I do to fix this please?

 

[apo]

Hi..

Can you upload the Workbook your using to somewhere like dropbox or mediafire (free accounts available at both)..

I should be able to fix it for you then..

 

[chowee21]

pm sent

 

[apo]

In your Combobox7_Click event.. try change your For Each line to:

For Each it In Range("H1:H" & Range("H" & Rows.Count).End(xlUp).Row).Offset(1).SpecialCells(12)

 

[chowee21]

In your Combobox7_Click event.. try change your For Each line to:

For Each it In Range("H1:H" & Range("H" & Rows.Count).End(xlUp).Row).Offset(1).SpecialCells(12)

That did solve that issue!

Do you think I should add that to all of my ComboBox click events in case it happens again?

 

[apo]

Not 100% sure.. leave the ComboBox7 code as it is now (with change i sent in previous post).. and try putting code liek this for all the other combos..

For Each it In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row).Offset(1).Resize(Range("B" & Rows.Count).End(xlUp).Row - 1, 1).SpecialCells(12)

It offsets it down 1 row and then resizes it to the row count -1 so that you don't get blanks in your combos..

Like i say.. not 100% sure.. see how you go..