Hi everyone, in the previous post

How To Make A Basic Excel VBA UserForm Search Box

I showed how to create a search form based on three columns, but
the issue with it was that it shows all the items in the column, and
doesn’t filter the data based on the previous selection.

In this post I will show you how to limit your selection based on the previous selection.

For example, here you see a sorted list of unique years:

Here you’ll see the makes that belong to those years:

We are going to be using the ADO library which makes this very easy and straight forward.

With ADO we don’t have to write extra code for selecting only unique values and sorting the list items.
We’ll let ADO do the “heavy lifting” for us so we don’t have to write so much code.

I’ll compare the 2 ways of writing this in another post.

Before we were using the “LoadBoxes” procedure which was loading all the combo boxes without ADO.

When we initialize the UserForm we are loading all the comboboxes with unique values:

Private Sub UserForm_Initialize()
    'LoadBoxes
    
    LoadYears
    LoadMakes
    LoadModels
    
End Sub

Private Sub LoadYears()
    'Purpose: Load combo with unique years
    
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim lngCount As Long
    Dim intCounter As Integer
    
    Me.cboYear.Clear
    
    'Set up the connection to the Excel worksheet
    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With
        
    'In order to do queries with a WHERE clause, you need to name the range, otherwise use the worksheet name.
   
    strSQL = "SELECT DISTINCT [Year] FROM [newtable] ORDER BY [Year]"
    
    Set rst = cnn.Execute(strSQL)
    
    lngCount = 0
    
    If Not rst.EOF Then
        Do Until rst.EOF
            Me.cboYear.AddItem rst(0)
               
           lngCount = lngCount + 1
           rst.Movenext
        Loop
        
        rst.Close
        Set rst = Nothing
        cnn.Close
        Set cnn = Nothing
    
    Else
    
        Me.lblMessage.Caption = "No data found based on your selections."
        DoEvents
    End If

    
End Sub

Private Sub LoadMakes()
    'Purpose: Load combo with unique makes
    
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim lngCount As Long
    Dim intCounter As Integer
    
    Me.cboMake.Clear
    
    'Set up the connection to the Excel worksheet
    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With
        
    'In order to do queries with a WHERE clause, you need to name the range, otherwise use the worksheet name.
   
    strSQL = "SELECT DISTINCT [Make] FROM [newtable] ORDER BY [Make]"
    
    Set rst = cnn.Execute(strSQL)
    
    lngCount = 0
    
    If Not rst.EOF Then
        Do Until rst.EOF
            Me.cboMake.AddItem rst(0)
               
           lngCount = lngCount + 1
           rst.Movenext
        Loop
        
        rst.Close
        Set rst = Nothing
        cnn.Close
        Set cnn = Nothing
    Else
    
        Me.lblMessage.Caption = "No data found based on your selections."
        DoEvents
    End If

    
End Sub


Private Sub LoadModels()
    'Purpose: Load combo with unique makes
    
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim lngCount As Long
    Dim intCounter As Integer
    
    Me.cboModel.Clear
    
    'Set up the connection to the Excel worksheet
    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With
        
    'In order to do queries with a WHERE clause, you need to name the range, otherwise use the worksheet name.
    
    strSQL = "SELECT DISTINCT [Model] FROM [newtable] ORDER BY [Model]"
    
    Set rst = cnn.Execute(strSQL)
    
    lngCount = 0
    
    If Not rst.EOF Then
        Do Until rst.EOF
            Me.cboModel.AddItem rst(0)
               
           lngCount = lngCount + 1
           rst.Movenext
        Loop
        
        rst.Close
        Set rst = Nothing
        cnn.Close
        Set cnn = Nothing
    Else
    
        Me.lblMessage.Caption = "No data found based on your selections."
        DoEvents
    End If

    
End Sub

We’ll use the combo box’s “Change” event to get the pass the combo box’s value to load the correct values on the others.

First when the year changes:

Private Sub cboYear_Change()
    'MsgBox "change model for " & Me.cboYear.Value
    ChangeMakes Me.cboYear.Value
    
End Sub

Private Sub ChangeMakes(year)
    'Purpose: Load combo with unique makes
    
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim lngCount As Long
    Dim intCounter As Integer
    
    
    If year = "" Then Exit Sub
    
    Me.cboMake.Clear
    
    'Set up the connection to the Excel worksheet
    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With
        
    'In order to do queries with a WHERE clause, you need to name the range, otherwise use the worksheet name.
   
    strSQL = "SELECT DISTINCT [Make] FROM [newtable] WHERE Year= " & year & " ORDER BY [Make]"
    
    Set rst = cnn.Execute(strSQL)
    
    lngCount = 0
    
    If Not rst.EOF Then
        Do Until rst.EOF
            Me.cboMake.AddItem rst(0)
               
           lngCount = lngCount + 1
           rst.Movenext
        Loop
        
        rst.Close
        Set rst = Nothing
        cnn.Close
        Set cnn = Nothing
    Else
    
        Me.lblMessage.Caption = "No data found based on your selections."
        DoEvents
    End If

    
End Sub

Second when the make changes, we want to update the models:

Private Sub cboMake_Change()
    ChangeModels Me.cboYear.Value, Me.cboMake.Value
End Sub

    'Purpose: Load combo with unique makes
    
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim lngCount As Long
    Dim intCounter As Integer
    
    If year = "" And make = "" Then Exit Sub
    
    
    Me.cboModel.Clear
    
    'Set up the connection to the Excel worksheet
    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With
        
    'In order to do queries with a WHERE clause, you need to name the range, otherwise use the worksheet name.
    
    strSQL = "SELECT DISTINCT [Model] FROM [newtable] WHERE [Year] =" & year & " AND [Make] = '" & make & "' ORDER BY Model"

    Set rst = cnn.Execute(strSQL)
    
    lngCount = 0
    
    If Not rst.EOF Then
        Do Until rst.EOF
            Me.cboModel.AddItem rst(0)
               
           lngCount = lngCount + 1
           rst.Movenext
        Loop
        
        rst.Close
        Set rst = Nothing
        cnn.Close
        Set cnn = Nothing
    Else
    
        Me.lblMessage.Caption = "No data found based on your selections."
        DoEvents
    End If

    
End Sub

So now when we search, we’ll always have a result!

    'Purpose: Find the item on the screen based on the textbox selections
    
    Dim cnn As Object
    Dim rst As Object
    Dim strSQL As String
    Dim lngCount As Long
    
    'Set up the connection to the Excel worksheet
    Set cnn = CreateObject("ADODB.Connection")
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
        .Open
    End With
    
    
    'In order to do queries with a WHERE clause, you need to name the range, otherwise use the worksheet name.
    'strSQL = "SELECT * FROM [Sheet1$]"
    strSQL = "SELECT * FROM [newtable] WHERE [Year] =" & Me.cboYear & " AND [Make] = '" & Me.cboMake & "' AND [Model] = '" & Me.cboModel & "'"

    Set rst = cnn.Execute(strSQL)
    
    lngCount = 0
    
    If Not rst.EOF Then
        Do Until rst.EOF
           'output = output & rst(0) & ";" & rst(1) & ";" & rst(2) & vbNewLine
           'Debug.Print rst(0); ";" & rst(1) & ";" & rst(2)
           
           lngCount = lngCount + 1
           rst.Movenext
        Loop
        
        rst.Close
        Set rst = Nothing
        cnn.Close
        Set cnn = Nothing
        
        Me.lblMessage.Caption = lngCount & " record(s) found based on your selections."
        DoEvents
    Else
    
        Me.lblMessage.Caption = "No data found based on your selections."
        DoEvents
    End If

    
End Sub

Watch how it’s done:

Let me know if you have any questions.