Is there a work around Xlookup and returning multiple values for the same search criteria?

Question

I have a list of about 80 different cities in all 50 states. Each city has a set of data that I want to pull from this list. On another sheet I have the button that opens a form to select a type of city (this being capital, coastal, and inner state), state (selection of states that are available within the selected type of city), and of course the city within the selected state.

The type of city selection uses option buttons, and the available states and cities use ListBoxes. I also have 3 labels that correspond to each selection and displays what will be inputted. I use Xlookup for both the state and city list to generator the selection for the user. This has been working great until I have multiple results from the same search criteria where it will only produce the first city (as expected).

For example, Texas is a large state, so I have multiple inner state cities. When I select Inner state as the type of city, then select Texas I only get the first results. SO my main question is, Is there a way to use Xlookup to display mutiple results with the same search criteria or do I need to use another function/extra coding.

This is an example of the Table I am using:

Picture of the form:

I have tried two different approaches. I am not the best at coding, but I have my fair share of tinkering projects, so I wanted to keep things simple. As far as I know, Xlookup only returns the first value and that can change depending on if Xlookup is looking from top to bottom or bottom to top first. Since I have multiple results and I want all of them to be available, I tried using the Filter function, but this bring up a 'type mismatch error' and the only work around I could find is to do of extra coding. I decided to then try Index-match functions which I cannot seem to get to work in VBA but it works just fine in the normal spreadsheet.

This is the code that is currently used to find the city based on the state selected and the type of city that was also selected. I have it as the working code. If I was to input the Filter or Index-Match function I would just replace where the Xlookup function is. The filter function I was originally trying is Application.Worksheets.Filter(State,InnerStateRange) and at the time the range included both what the InnerStateRange and InnerStateSearch encompassed. I gave up trying to use the Index-Match function as it was just confusing me more. I am happy to explain more or provide more as needed.

Private Sub State_List_Click()
Dim City1 As String 'City Selection caption
Dim City2 As String
Dim City3 As String


Dim State As String
State = State_List.Value 'State Value

Dim CapitalRange As Range 'Range for the Xlookup to intially look at
Dim CoastalRange As Range
Dim InnerStateRange As Range
Set CapitalRange = Worksheets("Information").Range("C6:C55")
Set CoastalRange = Worksheets("Information").Range("H6:H17")
Set InnerStateRange = Worksheets("Information").Range("M6:M20")

Dim CapitalSearch As Range 'Search range for Xlookup
Dim CoastalSearch As Range
Dim InnerStateSearch As Range
Set CapitalSearch = Worksheets("Information").Range("D6:D55")
Set CoastalSearch = Worksheets("Information").Range("I6:I17")
Set InnerStateSearch = Worksheets("Information").Range("N6:N20")


StateSelectionLabel.Caption = State_List.Value 'State selection Caption


If CapitalButton.Value = True Then 'City search in Capital Table
CityList.Clear

City1 = Application.WorksheetFunction.XLookup(State, CapitalRange, CapitalSearch, "N/A")

CityList.AddItem City1


ElseIf CoastalButton.Value = True Then 'City Search in Coastal Table
CityList.Clear

City2 = Application.WorksheetFunction.XLookup(State, CoastalRange, CoastalSearch, "N/A")

CityList.AddItem City2

ElseIf InnerStateButton.Value = True Then 'City Search in Inner State Table
CityList.Clear

City3 = Application.WorksheetFunction.XLookup(State, InnerStateRange, InnerStateSearch, "N/A")

CityList.AddItem City3

End If


End Sub

Answer 1

Using Find and FindNext

Option Explicit

Private Sub CapitalButton_Click()
    Call LoadState("C6")
End Sub

Private Sub CoastalButton_Click()
    Call LoadState("H6")
End Sub

Private Sub InnerStateButton_Click()
    Call LoadState("M6")
End Sub

Private Sub InnerState2Button_Click()
    Call LoadState("R6")
End Sub

Private Sub State_List_Click()
    
    StateSelectionLabel.Caption = State_List.Value
    
    If CapitalButton.Value = True Then
        LoadCity ("C6")
    ElseIf CoastalButton.Value = True Then
        LoadCity ("H6")
    ElseIf InnerStateButton.Value = True Then
        LoadCity ("M6")
    ElseIf InnerState2Button.Value = True Then
        LoadCity ("R6")
    End If
    
End Sub

Private Sub LoadState(addr As String)
    Dim col As Long, lastrow As Long
    Dim arList(), dict As Object, i As Long, state As String
    Set dict = CreateObject("Scripting.Dictionary")
    
    StateSelectionLabel.Caption = ""
    State_List.Clear
    CityList.Clear
    
    ' get list of unique states
    With Worksheets("Information")
        col = .Range(addr).Column
        lastrow = .Cells(.Rows.Count, col).End(xlUp).Row
        For i = .Range(addr).Row To lastrow
            state = .Cells(i, col)
            If Not dict.exists(state) Then dict.Add state, 1
        Next
    End With
    
    ' sort and add to Listbox
    arList = SortKeys(dict.keys)
    For i = 0 To UBound(arList)
        State_List.AddItem arList(i)
    Next
    
End Sub

Private Sub LoadCity(addr As String)
    Dim col As Long, lastrow As Long
    Dim rng As Range, c As Range, first As String
    Dim arList(), dict As Object, i As Long, city As String
    Set dict = CreateObject("Scripting.Dictionary")

    CityList.Clear
    With Worksheets("Information")
        col = .Range(addr).Column
        lastrow = .Cells(.Rows.Count, col).End(xlUp).Row
        Set rng = .Range(.Range(addr), .Cells(lastrow, col))
    End With
    
    ' search for cities with state
    Set c = rng.Find(State_List.Value, _
              lookat:=xlWhole, LookIn:=xlValues, MatchCase:=False)
    
    If Not c Is Nothing Then
        first = c.Address
        Do
            city = c.Offset(, 1).Value
            If Not dict.exists(city) Then dict.Add city, 1
            Set c = rng.FindNext(c)
        Loop While c.Address <> first
    End If
    
     ' sort and add to Listbox
    arList = SortKeys(dict.keys)
    For i = 0 To UBound(arList)
        CityList.AddItem arList(i)
    Next
      
End Sub


Private Function SortKeys(ar)
    ' buble sort array
    Dim i As Long, j As Long, n As Long
    Dim tmp As String
    
    n = UBound(ar)
    For i = 0 To n - 1
        For j = i + 1 To n
           If ar(j) < ar(i) Then
               tmp = ar(j)
               ar(j) = ar(i)
               ar(i) = tmp
           End If
        Next
    Next
    SortKeys = ar
End Function