How To Make A Basic Excel VBA UserForm Search Box

In this example I am going to show you how to query your worksheet for particular information using a UserForm.

Basically we are going to have a worksheet with data in it, and ask it a simple question:

“Does the criteria I selected in the UserForm exist in the worksheet?”

Here is a simple image of the worksheet:

…and here is the simple UserForm which is shown whenever the “Search” button is clicked:

When the UserForm “intializes” the comboboxes are filled in:

Here is the code I am using:

Private Sub UserForm_Initialize()
    LoadBoxes
End Sub


Sub LoadBoxes()
    Dim intCounter As Integer
    
    With Me.cboYear
        .Clear
        For intCounter = 1 To 70
            .AddItem Sheets("Sheet1").Cells(intCounter, 1).Value
        Next intCounter
    End With

    With Me.cboMake
        .Clear
        For intCounter = 1 To 70
            .AddItem Sheets("Sheet1").Cells(intCounter, 2).Value
        Next intCounter
    End With
    
    With Me.cboModel
        .Clear
        For intCounter = 1 To 70
            .AddItem Sheets("Sheet1").Cells(intCounter, 3).Value
        Next intCounter
    End With
End Sub

Since I am using the “Load” feature in multiple places, I am putting all the code in the “LoadBoxes” procedure.

After making my selections, I click on the “Search” button and a SQL statement is executed and a records found count is taken.

Here is the SQL statement I am using:

Private Sub btnSearch_Click()
    '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
          
           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

Excel views data that is formatted in consecutive columns as a table. So if I want to select the data from the entire sheet I can just use “[Sheet1$]”

However, since I want the ability to query individual columns, I need to set up a “named range”.

So here is the code all together:

Private Sub btnReset_Click()
    On Error Resume Next
    Selection.AutoFilter
    
    Me.cboYear.Clear
    Me.cboMake.Clear
    Me.cboModel.Clear
    
    Me.lblMessage.Caption = "Ready"
     
    LoadBoxes
    
End Sub

Private Sub UserForm_Initialize()
    LoadBoxes
End Sub


Sub LoadBoxes()
    Dim intCounter As Integer
    
    With Me.cboYear
        .Clear
        For intCounter = 1 To 70
            .AddItem Sheets("Sheet1").Cells(intCounter, 1).Value
        Next intCounter
    End With

    With Me.cboMake
        .Clear
        For intCounter = 1 To 70
            .AddItem Sheets("Sheet1").Cells(intCounter, 2).Value
        Next intCounter
    End With
    
    With Me.cboModel
        .Clear
        For intCounter = 1 To 70
            .AddItem Sheets("Sheet1").Cells(intCounter, 3).Value
        Next intCounter
    End With
End Sub
Private Sub btnSearch_Click()
    '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

Let me know if you have any questions.

[simple_contact_form]

****************************************************