VBA - Integrating Search Feature Into Specific UserForm Listbox

figuare9

Board Regular
Joined
Oct 23, 2017
Messages
118
I've created a custom userform to manage a database. This was heavily based off a "Datalabs" tutorial I found.

However, I'm a bit inexperienced with search features. In fact, I'm a bit inexperienced with with most vba still. ha.

So, this is the userform created that manages the database. Everything is in working order, except for the ability to search...

What I'd like to do, is be able to search for anything (in any column) and have it only return the results that match the search. I have zero code to support any attempts at this yet, especially since I'm not really sure where to start.

Not going to lie, this is my first attempt at a search function.. :) As you can see below in the Userform code, the "Search" button is completely empty..

Code below. Any help would be greatly appreciated!!

Download Link to Sheet: Job Ticket Log Database

1593182201164.png


Module 1 Code

VBA Code:
Sub Reset()
    Dim iRow As Long
   
    iRow = [Counta(ShopDatabase!A:A)] 'Indentifies Last Row
   
    With ShopForm
   
        .txtDate.Value = "" 'Clears All Values
        .txtJobNumber.Value = ""
        .txtCustomer.Value = ""
        .txtDescription.Value = ""
        .txtPO.Value = ""
        .txtDateReceived.Value = ""
        .txtDateRequired.Value = ""
        .txtDateWorkCompleted.Value = ""
        .txtShipDate.Value = ""
       
        .cmbOrderProgress.Clear 'Clears Combo Box
        .cmbOrderProgress.AddItem "In Progress" 'Adds Back Into Combo Box
        .cmbOrderProgress.AddItem "Completed"
       
        .txtRollNumber.Value = ""
       
        .txtComments.Value = ""
        .txtRollNumber.Value = ""
       
        .optPending.Value = False
        .optCarrier.Value = False
        .optInventory.Value = False
        .optMultipleOrders.Value = False
        .optOnTime.Value = False
        .optPeople.Value = False
        .optDueDateChanged.Value = False
        .optTrucks.Value = False
        .optDueDateAggressive.Value = False
        .optFreightBundling.Value = False
       
        .lstDatabase.ColumnCount = 13 'Sets Up The Column Count
        .lstDatabase.ColumnHeads = True 'Enables Headers
        .lstDatabase.ColumnWidths = "60,38,95,310,85,75,67,80,55,95,70,75,40" 'Defines the Width of each Column
       
        If iRow > 1 Then
            .lstDatabase.RowSource = "ShopDatabase!A2:M" & iRow
        Else
            .lstDatabase.RowSource = "ShopDatabase!A2:M2"
        End If
       
   
    End With



End Sub

Sub Submit()
   
    Dim sh As Worksheet
    Dim iRown As Long
   
    Set sh = ThisWorkbook.Sheets("ShopDatabase")
   
    If ShopForm.txtRowNumber.Value = "" Then
   
        iRow = [Counta(ShopDatabase!A:A)] + 1
    Else
   
        iRow = ShopForm.txtRowNumber.Value
    End If
   
    With sh
                    'Checks Delivery Impacts
                If ShopForm.optPending.Value = True Then
                    .Cells(iRow, 10) = "Pending"
                ElseIf ShopForm.optPeople.Value = True Then
                    .Cells(iRow, 10) = "People"
                ElseIf ShopForm.optCarrier.Value = True Then
                    .Cells(iRow, 10) = "Carrier"
                ElseIf ShopForm.optOnTime.Value = True Then
                    .Cells(iRow, 10) = "On Time"
                ElseIf ShopForm.optMultipleOrders.Value = True Then
                    .Cells(iRow, 10) = "Multiple Orders"
                ElseIf ShopForm.optDueDateChanged.Value = True Then
                    .Cells(iRow, 10) = "Due Date Changed"
                ElseIf ShopForm.optInventory.Value = True Then
                    .Cells(iRow, 10) = "Inventory"
                ElseIf ShopForm.optFreightBundling.Value = True Then
                    .Cells(iRow, 10) = "Freight Bundling"
                ElseIf ShopForm.optDueDateAggressive.Value = True Then
                    .Cells(iRow, 10) = "Due Date Aggressive"
                    Else
                        If ShopForm.optTrucks.Value = False Then
                        MsgBox ("You must select a delivery impact. If the order has not been shipped yet, please select Pending.")
                        Exit Sub
                        Else
                        .Cells(iRow, 10) = "Trucks"
                    End If
                End If
               

            .Cells(iRow, 1) = ShopForm.txtDate.Value
            .Cells(iRow, 2) = ShopForm.txtJobNumber.Value
            .Cells(iRow, 3) = ShopForm.txtCustomer.Value
            .Cells(iRow, 4) = ShopForm.txtDescription.Value
            .Cells(iRow, 5) = ShopForm.txtPO.Value
            .Cells(iRow, 6) = ShopForm.txtDateReceived.Value
            .Cells(iRow, 7) = ShopForm.txtDateRequired.Value
            .Cells(iRow, 8) = ShopForm.txtDateWorkCompleted.Value
            .Cells(iRow, 9) = ShopForm.txtShipDate.Value
            .Cells(iRow, 11) = ShopForm.cmbOrderProgress.Value
            .Cells(iRow, 12) = ShopForm.txtComments.Value
            .Cells(iRow, 13) = ShopForm.txtRollNumber.Value

    End With


End Sub


Sub Show_Form()
    ShopForm.Show
   
End Sub


Function Selected_List() As Long

    Dim i As Long
   
    Selected_List = 0
   
    For i = 0 To ShopForm.lstDatabase.ListCount - 1
   
        If ShopForm.lstDatabase.Selected(i) = True Then
       
            Selected_List = i + 1
       
        Exit For
        End If
       
    Next i
   
   
End Function


UserForm Code

Code:
Private Sub cmdDelete_Click()

    If Selected_List = 0 Then
            MsgBox "No Data Selected. Please select a work order to delete.", vbOKOnly + vbInformation, "Delete"
        Exit Sub
    End If

    Dim i As VbMsgBoxResult
    i = MsgBox("Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")
   
    If i = vbNo Then Exit Sub
    ThisWorkbook.Sheets("ShopDatabase").Rows(Selected_List + 1).Delete
   
   
Call Reset
   
    MsgBox "Selected record has been deleted.", vbOKOnly + vbInformation, "Deleted"


End Sub

Private Sub cmdEdit_Click()

    If Selected_List = 0 Then
        MsgBox "No row has been selected.", vbOKOnly + vbInformation, "Edit"
        Exit Sub
       
    End If
    'Update the value to respective controls
    Dim sDeliveryImpacts As String
   
    Me.txtRowNumber.Value = Selected_List + 1
    Me.txtDate.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 0)
    Me.txtJobNumber.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 1)
    Me.txtCustomer.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
    Me.txtDescription.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
    Me.txtPO.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
    Me.txtDateReceived.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)
    Me.txtDateRequired.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 6)
    Me.txtDateRequired.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 7)
    Me.txtShipDate.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 8)
    sDeliveryImpacts = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 9)
   
    If sDeliveryImpacts = "Pending" Then
        Me.optPending.Value = True
    ElseIf sDeliveryImpacts = "People" Then
        Me.optPeople.Value = True
    ElseIf sDeliveryImpacts = "Carrier" Then
        Me.optCarrier.Value = True
    ElseIf sDeliveryImpacts = "On Time" Then
        Me.optOnTime.Value = True
    ElseIf sDeliveryImpacts = "Multiple Orders" Then
        Me.optMultipleOrders.Value = True
    ElseIf sDeliveryImpacts = "Due Date Changed" Then
        Me.optDueDateChanged.Value = True
    ElseIf sDeliveryImpacts = "Inventory" Then
        Me.optInventory.Value = True
    ElseIf sDeliveryImpacts = "Freight Bundling" Then
        Me.optFreightBundling.Value = True
    ElseIf sDeliveryImpacts = "Due Date Aggressive" Then
        Me.optDueDateAggressive.Value = True
    Else: Me.optTrucks.Value = True
        End If
       
    Me.cmbOrderProgress.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 10)
    Me.txtComments.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)
    Me.txtRollNumber.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 12)
   
End Sub

Private Sub cmdReset_Click()
    Dim msgValue As VbMsgBoxResult
   
    msgValue = MsgBox("Do you want to reset the data?", vbYesNo + vbInformation, "Confirmation")
   
    If msgValue = vbNo Then Exit Sub
   
    Call Reset
End Sub

Private Sub cmdSave_Click()

    Dim msgValue As VbMsgBoxResult
   
    msgValue = MsgBox("Do you want to save the data?", vbYesNo + vbInformation, "Confirmation")
   
    If msgValue = vbNo Then Exit Sub
   
    Call Submit
    Call Reset
   
   
End Sub

Private Sub cmdSearch_Click()

End Sub

Private Sub UserForm_Initialize()

Call Reset

End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,224,827
Messages
6,181,198
Members
453,022
Latest member
RobertV1609

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top