Search for specific data and wildcard option

[josros60]

Hi,

I found the code below the problem is can only find if type the SAGEID but want to be able to search for other fields listed in the code if possible to search wildcard the SearchForm have five textboxes to search for for example if just want to find JS Analyst when type for that list all of them (attaching picture of the form).

here is the code:

Private Sub SearchBtn_Click()

    Dim SearchTerm As String
    Dim SearchColumn As String
    Dim RecordRange As Range
    Dim FirstAddress As String
    Dim FirstCell As Range
    Dim RowCount As Integer
    
    ' Display an error if no search term is entered
    If SAGEID.Value = "" And VENDOR.Value = "" And GL_ACCOUNT.Value = "" And OrgUnit.Value = "" And Analyst.Value = "" Then
    
        MsgBox "No search term specified", vbCritical + vbOKOnly
        Exit Sub
    
    End If
    
    ' Work out what is being searched for
    If SAGEID.Value <> "" Then
    
        SearchTerm = SAGEID.Value
        SearchColumn = "SAGEID"
        
    End If
    
    If VENDOR.Value <> "" Then
    
        SearchTerm = VENDOR.Value
        SearchColumn = "VENDOR"
        
    End If

    If OrgUnit.Value <> "" Then
    
        SearchTerm = GL_ACCOUNT.Value
        SearchColumn = "G/L ACCOUNT"
        
    End If

    If OrgUnit.Value <> "" Then
    
        SearchTerm = OrgUnit.Value
        SearchColumn = "ORG UNIT"
        
        If Analyst.Value <> "" Then
    
        SearchTerm = Analyst.Value
        SearchColumn = "Analyst"
        
    End If
    
    End If
    Results.Clear
    
        ' Only search in the relevant table column i.e. if somone is searching Location
        ' only search in the Location column
        With Range("Table1[" & SearchColumn & "]")
        
        ' Find the first match
            Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)

            ' If a match has been found
            If Not RecordRange Is Nothing Then

                FirstAddress = RecordRange.Address
                RowCount = 0

                Do
                
                    ' Set the first cell in the row of the matching value
                    Set FirstCell = Range("A" & RecordRange.Row)
                    
                    ' Add matching record to List Box
                    Results.AddItem
                    Results.List(RowCount, 0) = FirstCell(1, 1)
                    Results.List(RowCount, 1) = FirstCell(1, 2)
                    Results.List(RowCount, 2) = FirstCell(1, 3)
                    Results.List(RowCount, 3) = FirstCell(1, 4)
                    Results.List(RowCount, 4) = FirstCell(1, 5)
                    Results.List(RowCount, 5) = FirstCell(1, 6)
                    Results.List(RowCount, 6) = FirstCell(1, 7)
                    Results.List(RowCount, 7) = FirstCell(1, 8)
                    Results.List(RowCount, 8) = FirstCell(1, 9)
                    RowCount = RowCount + 1
                    
                    ' Look for next match
                    Set RecordRange = .FindNext(RecordRange)

                    ' When no further matches are found, exit the sub
                    If RecordRange Is Nothing Then

                        Exit Sub

                    End If

                ' Keep looking while unique matches are found
                Loop While RecordRange.Address <> FirstAddress

            Else
            
                ' If you get here, no matches were found
                Results.AddItem
                Results.List(RowCount, 0) = "Nothing Found"
            
            End If
          
            

        End With

End Sub

Thank you,

 

[josros60]

Hi,

Copied and pasted your whole code but now getting run-time error 424 object required and highlighting this line:

If SAGEID.Value <> "" Then Arr(1, 2) = SAGEID.Value: Arr(1, 1) = "SAGEID"

Thank you,

 

[josros60]

Hi,

I copied and pasted your last suggestion code but now giving me error "Run-time 424, object required" and highlight this line:

If SAGEID.Value <> "" Then Arr(1, 2) = SAGEID.Value: Arr(1, 1) = "SAGEID"

thank you

 

[BSALV]

I sent you a file (bottom of #10), does that file work on your computer ?
You work with a userform, i suppose, but to simulate that, was too much work, so i created several defined names, also called "SageID", etc.
So it's important now, to know, with what are you working, my attachment or my macro in your UF ?

In last case, you have to delete those first 5 lines, set ... = range("..."), otherwise excel doesn't know what to do.

 

[josros60]

I did commented out those lines,

this is the code I am using now:

Sub SearchBtn_Click()
     Dim SAGEID, VENDOR, GL_ACCOUNT, OrgUnit, Analyst As Long
     '************************************************
    [COLOR=rgb(97, 189, 109)] ' this is for me, testing with ranges instead of textboxes
     'Set SAGEID = Range("sageid")
     'Set VENDOR = Range("vendor")
     'Set GL_ACCOUNT = Range("gl_account")
     'Set OrgUnit = Range("OrgUnit")
     'Set Analyst = Range("Analyst")[/COLOR]
     '*************************************************

     Dim sh, LO, DBR, HRR, C As Range, c1, MyResults, Arr(), Dict, r, bFlag, i
     Set Dict = CreateObject("scripting.dictionary")            'dictionary for the result
     Set C = Range("Table1")                                    '
     Set LO = C.ListObject                                      'your listobject
     DBR = LO.DataBodyRange.Value                               'read the databodyrange
     HRR = LO.HeaderRowRange.Value                              'read the headerrow
     Dict.Add Dict.Count, HRR                                   '1st item in dictionary=headerrow, 'll be deleted immediately when assigning combobox

     'prepare an array for filtering
     ReDim Arr(1 To 5, 1 To 3)                                  '5 terms
     If SAGEID.Value <> "" Then Arr(1, 2) = SAGEID.Value: Arr(1, 1) = "SAGEID"
     If VENDOR.Value <> "" Then Arr(2, 2) = VENDOR.Value: Arr(2, 1) = "VENDOR"
     If GL_ACCOUNT.Value <> "" Then Arr(3, 2) = GL_ACCOUNT.Value: Arr(3, 1) = "G/L ACCOUNT"
     If OrgUnit.Value <> "" Then Arr(4, 2) = OrgUnit.Value: Arr(4, 1) = "ORG UNIT"
     If Analyst.Value <> "" Then Arr(5, 2) = Analyst.Value: Arr(5, 1) = "Analyst"
     For i = 1 To UBound(Arr)
          On Error Resume Next
          Set c1 = Nothing: Set c1 = LO.ListColumns(Arr(i, 1)).Range     'find corresponding listcolumn and columnnumber
          On Error GoTo 0
          If c1 Is Nothing Then
               MsgBox "no column " & Arr(i, 1)
          Else
               If Len(Arr(i, 1)) > 0 Then Arr(i, 3) = LO.ListColumns(Arr(i, 1)).Range.Column - LO.Range.Column + 1
          End If
     Next

     'loop through data and if okay add to dictionary
     For r = 1 To UBound(DBR)                                   'loop through all data
          bFlag = True
          For i = 1 To UBound(Arr)                              'loop through all filters
               If Arr(i, 3) > 0 Then bFlag = (DBR(r, Arr(i, 3)) = Arr(i, 2))     'check if element in that column is okay
               If bFlag = False Then Exit For                   'if flag no more okay then stop loop
          Next
          If bFlag Then
               Dict.Add Dict.Count, Application.Index(DBR, r, 0)     'if flag still okay, add to dictionary
          End If
     Next

     'dictionary -> combobox or listbox
     MyResults = Application.Index(Dict.items, 0, 0)            'read the dictionary
     With Blad2.ComboBox1
          .Clear
          Select Case Dict.Count
               Case 1: MsgBox "nothing left"                    'just the headerrow, so there is no data
               Case Else:
                    .List = MyResults
                    .RemoveItem 0                               'remove headerrrow
          End Select
          .DropDown
    End With
End Sub

Sorry, no so good in VBA just replaced your last suggestion I download your file as well the file won't work.

Thank you

 

[BSALV]

Comment out also the 1st line with Dim.
Does it work now ?
You added this in the programcode of your UF ?

 

[josros60]

Yes, i added the code to my search button in my userform. and commented out the following lines but now when click search keep displaying " no column" five times and closed guess the are the five columns.

Commented out code:

'Dim SAGEID, VENDOR, GL_ACCOUNT, OrgUnit, Analyst
     '************************************************
    '[COLOR=rgb(97, 189, 109)] ' this is for me, testing with ranges instead of textboxes
     'Set SAGEID = Range("sageid")
     'Set VENDOR = Range("vendor")
     'Set GL_ACCOUNT = Range("gl_account")
     'Set OrgUnit = Range("OrgUnit")
     'Set Analyst = Range("Analyst")[/COLOR]
     '*************************************************


 'With Blad2.ComboBox1
         ' .Clear
          'Select Case Dict.Count
               'Case 1: MsgBox "nothing left"                    'just the headerrow, so there is no data
               'Case Else:
                    '.List = MyResults
                    '.RemoveItem 0                               'remove headerrrow
          'End Select
          '.DropDown
    'End With

Thank you