Create a search userform to search using multiple criteria

Question

i have created a userform which searches from the data using the value that i put in text box

for e.g if i put student i.d in textbox1 all other textbox show me the data like name contact detail etc.

but i want one more criteria. i want to add one more textbox to search for e.g either i put student i.d or locker no whereas right now i can only put student i.d

Private Sub CommandButton2_Click()
terminate.Enabled = True

       If TextBox1.Value = "" Then
        MsgBox "Dude enter the I.D number -_-"
        Exit Sub
      Else

row_number = 0
Do
DoEvents
row_number = row_number + 1
 item_in_review = Sheets("sheet1").Range("C" & row_number)
   If item_in_review = TextBox1.Text Then
   TextBox2.Text = Sheets("sheet1").Range("B" & row_number)
    TextBox3.Text = Sheets("sheet1").Range("D" & row_number)
     TextBox4.Text = Sheets("sheet1").Range("K" & row_number)
      TextBox5.Text = Sheets("sheet1").Range("F" & row_number)
       TextBox6.Text = Sheets("sheet1").Range("G" & row_number)
        TextBox7.Text = Sheets("sheet1").Range("J" & row_number)
         TextBox8.Text = Sheets("sheet1").Range("A" & row_number)
         
End If

Loop Until item_in_review = " "

End If
Forms.UserForm1.Close

End Sub

Answer 1

I created a simple case to illustrate how to do what you want to do, and also to simplify your code a little.  The code comes first, then some screen snaps  showing the two different ways to look up a student.  I only have four TextBoxes, so adjust to your needs.

Eric

'****** BEGIN CODE ******

' This code goes into the code module of the UserForm, and is associated with "CommandButton1",

' which is labeled "Find" in my sample.

Option Explicit

Private Sub CommandButton1_Click()

    Dim nRows as Long

    Dim theID as Long

    Dim theLocker as String

    Dim theRow as Long

'

' Must have either Student ID or Locker Number filled in

'

    If (TextBox1.Text = "" and TextBox4.Text = "") Then

        MsgBox "Dude - you must enter either the Student ID or the Locker Number!", vbOKOnly + vbCritical, "Missing Input"

        Exit Sub

    End If

'

    nRows = ActiveWorkbook.Worksheets("Sheet1").Range("A1").End(xlDown).Row - 1 ' Subtract 1 for header row

'

' Find student with ID or Locker Number:

'

    On Error GoTo StudentNotFound

    If (TextBox1.Text <> "") Then ' Priority is to search by Student ID

        theID = TextBox1.Value

        theRow = Application.WorksheetFunction.Match(theID, ActiveWorkbook.Worksheets("Sheet1").Range("$A1:$A" & nRows + 1), 0)

        Me.TextBox2.Text = ActiveWorkbook.Worksheets("Sheet1").Range("B" & theRow).Text

        Me.TextBox3.Text = ActiveWorkbook.Worksheets("Sheet1").Range("C" & theRow).Text

        Me.TextBox4.Text = ActiveWorkbook.Worksheets("Sheet1").Range("D" & theRow).Text

    Else ' Search by Locker Number if Student ID is not present

        theLocker = TextBox4.Text

        theRow = Application.WorksheetFunction.Match(theLocker, ActiveWorkbook.Worksheets("Sheet1").Range("$D1:$D" & nRows + 1), 0)

        Me.TextBox1.Text = ActiveWorkbook.Worksheets("Sheet1").Range("A" & theRow).Text

        Me.TextBox2.Text = ActiveWorkbook.Worksheets("Sheet1").Range("B" & theRow).Text

        Me.TextBox3.Text = ActiveWorkbook.Worksheets("Sheet1").Range("C" & theRow).Text

    End If

    On Error Goto 0

    Exit Sub

'

StudentNotFound:

    Me.TextBox2.Text = "Not Found!"

End Sub

Example:  Search by Student ID

Example:  Search by Locker Number

Answer 2

Change this:

Dim theLocker as String

to this:

Dim theLocker as Long

and it should work.

Eric

Answer 3

it works fine for student i.d but for locker num it says not found!

Private Sub CommandButton2_Click()

terminate.Enabled = True

CommandButton4.Enabled = True

CommandButton1.Enabled = True

CommandButton3.Enabled = True

    Dim nRows As Long

    Dim theID As Long

    Dim theLocker As String

    Dim theRow As Long

'

' Must have either Student ID or Locker Number filled in

'

    If (TextBox1.Text = "" And TextBox3.Text = "") Then

        MsgBox "Dude - you must enter either the Student ID or the Locker Number!", vbOKOnly + vbCritical, "Missing Input"

        Exit Sub

    End If

'

    nRows = ActiveWorkbook.Worksheets("Sheet1").Range("C1").End(xlDown).Row - 1 ' Subtract 1 for header row

'

' Find student with ID or Locker Number:

'

    On Error GoTo StudentNotFound

    If (TextBox1.Text <> "") Then ' Priority is to search by Student ID

        theID = TextBox1.Value

        theRow = Application.WorksheetFunction.Match(theID, ActiveWorkbook.Worksheets("Sheet1").Range("$c1:$c" & nRows + 1), 0)

        Me.TextBox2.Text = ActiveWorkbook.Worksheets("Sheet1").Range("B" & theRow).Text

        Me.TextBox8.Text = ActiveWorkbook.Worksheets("Sheet1").Range("A" & theRow).Text

        Me.TextBox3.Text = ActiveWorkbook.Worksheets("Sheet1").Range("D" & theRow).Text

    Else ' Search by Locker Number if Student ID is not present

        theLocker = TextBox3.Text

        theRow = Application.WorksheetFunction.Match(theLocker, ActiveWorkbook.Worksheets("Sheet1").Range("$D1:$D" & nRows + 1), 0)

        Me.TextBox8.Text = ActiveWorkbook.Worksheets("Sheet1").Range("A" & theRow).Text

        Me.TextBox2.Text = ActiveWorkbook.Worksheets("Sheet1").Range("B" & theRow).Text

        Me.TextBox3.Text = ActiveWorkbook.Worksheets("Sheet1").Range("D" & theRow).Text

    End If

    On Error GoTo 0

    Exit Sub

'

StudentNotFound:

    Me.TextBox2.Text = "Not Found!"

End Sub

Answer 4

but i want one more criteria. i want to add one more textbox to search for e.g either i put student

You can use all your existing Textboxes for a search, not hard to code, but maybe to understand.

a) The basic is to use RANGE.FIND (please read the help on this) and find all values in a column. That is similar what you did, but using a RANGE object.

b) During the search we can combine all cells and get one RANGE object as result, please read the help on UNION.

I use these techniques in my FindAll function.

c) When we want to search another column, we can use INTERSECT (please read the help on this) and RANGE.ENTIREROW to build a RANGE object that contains only the cells within that column that intersects with the rows that we already found.

d) Now we have a new RANGE object that reflects the results that match all criteria and repeat with a) until we checked all criteria.

e) The easiest universal way to code such a thing for a Userform is to use the TAG property of the controls and a simple FOR EACH loop over all controls.

If we store the column name into the TAG, we know which column should be search for the value of the control.

Add , resp. expand your exiting subs with the code below.

Andreas.

Private Sub UserForm_Initialize()

  With Me

    'Store the column name into the TAG property

    .TextBox1.Tag = "C"

    .TextBox2.Tag = "B"

    .TextBox3.Tag = "D"

    .TextBox4.Tag = "K"

    .TextBox5.Tag = "F"

    .TextBox6.Tag = "G"

    .TextBox7.Tag = "J"

    .TextBox8.Tag = "A"

  End With

End Sub

Private Sub CommandButton2_Click()

  Dim All As Range, R As Range

  Dim C As MSForms.Control

  'Visit each control

  For Each C In Me.Controls

    'Did we have a TAG and a VALUE?

    If C.Tag <> "" And C <> "" Then

      'Found any results before?

      If All Is Nothing Then

        'Search the whole column

        Set All = Columns(C.Tag)

      Else

        'Search only the rows of our result in the column

        Set All = Intersect(All, Columns(C.Tag))

      End If

      'Search the column

      Set R = FindAll(All, C)

      'Found?

      If R Is Nothing Then

        MsgBox "No matches found"

        Exit Sub

      End If

      'Set this rows as result

      Set All = R.EntireRow

    End If

  Next

  'Found something?

  If Not All Is Nothing Then

    All.Select

    MsgBox "Here are the results"

  Else

    MsgBox "No matches found"

  End If

End Sub

Function FindAll(ByVal Where As Range, ByVal What, _

    Optional ByVal After As Variant, _

    Optional ByVal LookIn As XlFindLookIn = xlValues, _

    Optional ByVal LookAt As XlLookAt = xlWhole, _

    Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _

    Optional ByVal SearchDirection As XlSearchDirection = xlNext, _

    Optional ByVal MatchCase As Boolean = False, _

    Optional ByVal SearchFormat As Boolean = False) As Range

  'Find all occurrences of What in Where

  Dim FirstAddress As String

  Dim C As Range

  'From FastUnion:

  Dim Stack As Object 'Dictionary

  Dim Temp() As Variant

  Dim i As Long, j As Long

  If Where Is Nothing Then Exit Function

  If SearchDirection = xlNext And IsMissing(After) Then

    'Set After to the last cell in Where to return the first cell in Where in front if _

      it match What

    Set C = Where.Areas(Where.Areas.Count)

    'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet

    'Set After = C.Cells(C.Cells.Count)

    Set After = C.Cells(C.Rows.Count * CDec(C.Columns.Count))

  End If

  Set C = Where.Find(What, After, LookIn, LookAt, SearchOrder, _

    SearchDirection, MatchCase, SearchFormat:=SearchFormat)

  If C Is Nothing Then Exit Function

  'Initialize our internal stack

  Set Stack = CreateObject("Scripting.Dictionary")

  FirstAddress = C.Address

  Do

    Stack.Add Stack.Count, C

    If SearchFormat Then

      'If you call this function from an UDF and _

        you find only the first cell use this instead

      Set C = Where.Find(What, C, LookIn, LookAt, SearchOrder, _

        SearchDirection, MatchCase, SearchFormat:=SearchFormat)

    Else

      If SearchDirection = xlNext Then

        Set C = Where.FindNext(C)

      Else

        Set C = Where.FindPrevious(C)

      End If

    End If

    'Can happen if we have merged cells

    If C Is Nothing Then Exit Do

  Loop Until FirstAddress = C.Address

  'FastUnion algorithm © Andreas Killer, 2011:

  'Get all cells as fragments

  Temp = Stack.Items

  'Combine each fragment with the next one

  j = 1

  Do

    For i = 0 To UBound(Temp) - j Step j * 2

      Set Temp(i) = Union(Temp(i), Temp(i + j))

    Next

    j = j * 2

  Loop Until j > UBound(Temp)

  'At this point we have all cells in the first fragment

  Set FindAll = Temp(0)

End Function