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: