VBA Form / Search with two criterias

[Young Grasshopper]

Hi,

I'm pretty new to VBA coding, and struggling to get VBA to understand what i want it to do..
I have a VBA form where i want to search for geotags, and if i search in "Locations" or in "Country Code" i get the results i want. But i want to do a search in both textboxes, f.ex: "Bergen" in location, and "NO" in Country code, and only get the results that match with both..

The code is a little massy still so Location textbox is "FName" and Country Code textbox is "LName".
"Table1" is just a table with column A:D, and Canonical Name (location) is in column A, and Country Code is in column D.
This is the code i have now, and don't really know "Where" to let Vba know i want it to search two values in two columns;

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
   
    If FName.Value = "" And LName.Value = "" Then
   
        MsgBox "No search term specified", vbCritical + vbOKOnly
        Exit Sub
   
    End If
   
    If FName.Value <> "" Then
   
        SearchTerm = FName.Value
        SearchColumn = "Canonical Name"
       
    End If
   
    If LName.Value <> "" Then
   
        SearchTerm = LName.Value
        SearchColumn = "Country Code"
       
       
    End If
   
    Results.Clear

        With Range("Table1[" & SearchColumn & "]")

            Set RecordRange = .Find(SearchTerm, LookIn:=xlValues)

            If Not RecordRange Is Nothing Then

                FirstAddress = RecordRange.Address
                RowCount = 0

                Do

                    Set FirstCell = Range("A" & RecordRange.Row)
                   
                    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)
                    RowCount = RowCount + 1
                   
                    Set RecordRange = .FindNext(RecordRange)

                    If RecordRange Is Nothing Then

                        Exit Sub

                    End If


                Loop While RecordRange.Address <> FirstAddress

            Else
           
                Results.AddItem
                Results.List(RowCount, 0) = "Nothing Found"
           
            End If

        End With

End Sub

I would appreciate any help

 

[dmt32]

Hi,
just run my suggestion on your workbook & all seems to work ok with sample data?

Did you change the worksheet & table names in the code as stated in the Intialize event which should be as shown below in RED bold.

Private Sub UserForm_Initialize()
    'worksheet object (change name as required)
    Set ws = ThisWorkbook.Worksheets("Search")
    'Table Object (change name as required)
    Set tblTable = ws.ListObjects("Table_1")
 
    Me.Results.ColumnCount = tblTable.DataBodyRange.Columns.Count
End Sub

Dave

 

[Young Grasshopper]

Woopsy.. Yes, i misunderstood where to paste the code..
The Code works great Dave, but as soon as I start typing, the form freezes for like 10-15 seconds before I get the results. This is on my laptop, which granted isn't the best, so as soon as put the same code under a button click, it's great.

There is one problem tho. F.ex the location "Bergen,Vestland,Norway" or "Bergen Vestland,Norway", I need to be able to just search Vestland and still get these results.
Would it be possible to tweak the code for this?

 

[dmt32]

Hi,
glad we are getting there

try this update to main code & see if does what you want

Sub SearchGeoTags(ByVal objListBox As Object, ByVal objTable As ListObject, ParamArray Search() As Variant)
    Dim SearchColumn(1 To 2) As Long, r  As Long, c As Long
    Dim arr                  As Variant
  
    'intialize array
    arr = objTable.DataBodyRange.Value
  
    'search columns
    SearchColumn(1) = 1        'Canonical Name
    SearchColumn(2) = 4        'Country Code
  
    With objListBox
        .Clear
        If Len(Search(0)) = 0 Then Exit Sub
        For r = 1 To UBound(arr, xlRows)
            If UCase(arr(r, SearchColumn(1))) Like "*" & UCase(Search(0)) & "*" And _
               UCase(arr(r, SearchColumn(2))) Like "*" & UCase(Search(1)) Then
                .AddItem arr(r, 1)
                For c = 2 To UBound(arr, xlColumns)
                    .List(.ListCount - 1, c - 1) = arr(r, c)
                Next c
            End If
        Next r
    End With
End Sub

If finding displaying results whilst typing sluggish then you can if want to, go back to your search button idea

to do so delete these two codes

Private Sub FName_Change()
    'Location.
    SearchGeoTags Me.Results, tblTable, Me.FName, Me.LName
End Sub

Private Sub LName_Change()
    'Country Code.
    SearchGeoTags Me.Results, tblTable, Me.FName, Me.LName
End Sub

and update your button code as follows

Private Sub SearchBtn_Click()
    SearchGeoTags Me.Results, tblTable, Me.FName, Me.LName
End Sub

this should allow you to type the primary search in Location textbox & pressing button should display all matches. The enter Country Code & pressing button again should filter final result

Dave

 

[Young Grasshopper]

Works like a charm, Dave!!
Thank you so much, and enjoy the rest of your evening, mate

 

[dmt32]

Works like a charm, Dave!!
Thank you so much, and enjoy the rest of your evening, mate

You are most welcome but I was not thinking & should have realized that writing to the listbox each time from large data set likely to be sluggish & would have been better to write to it once with final result from an array.

If though solution is now doing what you want then probably best to leave it at that.

appreciate your feedback

Dave