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
you can modify your Range.Find method code to do what you want but may find it quicker to read the databodyrange of your table in to a variant array and then check against the required column elements (1 & 4) of the array for search criteria matches

make a backup of your workbook & then delete existing search codes & button as this will not be needed.

place these codes in the userform code page

Dim tblTable    As ListObject
Dim ws          As Worksheet
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

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

You will need to CHANGE the names of the worksheet & Table as required

Place following code in a standard module

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

code only lightly tested but should find as start typing entry in Location textbox, the listbox will begin to fill with likely matches
when done, enter text in country code - the listbox will clear until match(s) for both values are found

Hope Helpful

Dave

 

[Young Grasshopper]

Thanks dave,
The "problem" is that there is almost 150k lines of data, and from earlier tests, Excel just craches when trying to quickly read trough it.
That's why i added the search function.

 

[Akuini]

The "problem" is that there is almost 150k lines of data,

Could you upload a sample workbook (without sensitive data) to a sharing site like dropbox.com or google drive?
And then share the link here.
Just include about 1K rows of data.

 

[Young Grasshopper]

Sure

https://docs.google.com/spreadsheets/d/13mF3kwINMuO98jbMzu5ECglmEO4nKfrj/edit?usp=sharing&ouid=107240966272407838786&rtpof=true&sd=true

 

[Akuini]

I got access denied when trying to download it.

Sure
https://docs.google.com/spreadsheet...ouid=107240966272407838786&rtpof=true&sd=true

 

[dmt32]

Thanks dave,
The "problem" is that there is almost 150k lines of data, and from earlier tests, Excel just craches when trying to quickly read trough it.

curious not an issue I have come across when using arrays but will have a look at your workbook link & see if can adapt suggestion to resolve it.

meanwhile,
try using update to code which requires an exact match (no filtering) & see if this helps

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))) = UCase(Search(0)) And _
               UCase(arr(r, SearchColumn(2))) = 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

Dave

 

[Young Grasshopper]

https://docs.google.com/spreadsheets/d/13mF3kwINMuO98jbMzu5ECglmEO4nKfrj/edit?usp=drivesdk&ouid=107240966272407838786&rtpof=true&sd=true

 

[Akuini]

I still can't access your workbook. Probably you have different setting, try:
On your google drive:
Right click the file you want to share > Click Get Link > don't choose "Restricted", choose "Anyone with link" instead > Click Copy Link > now you get the link, just paste the link here.

 

[Young Grasshopper]

Ah,

Sorry, this should be right:

Geotag_Sample.xlsm

drive.google.com