I want to check if the current destination string is located within the destination search array once the origins match up. The outcome is supposed to be all flights between any originSearch city and destinationSearch city and the corresponding flight number

I was playing with a boolean that stores all the true matches but I got confused.

Sub Matches()
    Dim nFlights As Integer
    Dim origin() As String
    'Dim isOwned() As Boolean
    Dim flightNumber() As String
    Dim destination() As String
    Dim iOrigin As Integer
    Dim iDestination As Integer
    Dim iFlight As Integer
    Dim nOrigins As Integer
    Dim nDestinations As Integer
    Dim originSearch() As String
    Dim destinationSearch() As String
    Dim i As Integer
    Dim x As Integer
    Dim m As Integer
    
    With wsData.Range("A1")
        nFlights = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
        ReDim origin(1 To nFlights)
        ReDim flightNumber(1 To nFlights)
        ReDim destination(1 To nFlights)
        'ReDim isOwned(1 To nFlights)
        
        'stores the origin column in an array
        For iOrigin = 1 To nFlights
            'isOwned(iOrigin) = False
            origin(iOrigin) = .Offset(iOrigin, 0).Value
        Next
    
    'stores the destination column in an array
        For iDestination = 1 To nFlights
            'isOwned(iDestination) = False
            destination(iDestination) = .Offset(iDestination, 1).Value
        Next
    
    'stores the flight column in an array
        For iFlight = 1 To nFlights
            'isOwned(iFlight) = False
            flightNumber(iFlight) = .Offset(iFlight, 2).Value
        Next
    End With
    
     With wsData.Range("E1")
     nOrigins = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
     nDestinations = 4 'Range(.Offset(1, 1), .End(xlDown)).Rows.Count
     
     ReDim originSearch(1 To nOrigins)
     ReDim destinationSearch(1 To nDestinations)
     
     For i = 1 To nOrigins
            originSearch(i) = .Offset(i, 0).Value
            For x = 1 To nDestinations
                destinationSearch(x) = .Offset(x, 1).Value
                For m = 1 To nFlights
                    If origin(m) = originSearch(i) And destination(m) = destinationSearch(x) Then
                        wsData.Range("H1").Offset(i, 0).Value = originSearch(i)
                        wsData.Range("H1").Offset(x, 1).Value = destinationSearch(x)
                        wsData.Range("H1").Offset(x, 2).Value = flightNumber(m)
                    End If
                Next m
            Next x
        Next i
    End With
 
End Sub

CodePudding user response：

There should only be a single nested for loop at the end there. So for each origin_dest-pair search value, you're searching each origin_dest-pair record value.

This adds all the flight numbers of matching scenarios into an array and then puts the flight numbers into the next available column.

Also Ranges are essentially Variant() arrays, so you can just assign one to the other, instead of iterating through each value.

Option Compare Text

Sub FindFlightNumbers()
    Dim orig() As Variant: orig = Range("A2:A" & Range("A2").End(xlDown).Row)
    Dim dest() As Variant: dest = Range("B2:B" & Range("B2").End(xlDown).Row)
    Dim flight_nums() As Variant:  flight_nums = Range("C2:C" & Range("C2").End(xlDown).Row)
    
    'Turn 2-D arrays into 1-D arrays
    orig = Application.Transpose(orig)
    dest = Application.Transpose(dest)
    flight_nums = Application.Transpose(flight_nums)
    
    Dim orig_search As Range: Set orig_search = Range("E2:E" & Range("e2").End(xlDown).Row)
    Dim search_cell As Range, i As Integer
    
    For Each search_cell In orig_search
        Dim match_numbers() As Variant
        
        For i = 1 To UBound(orig)
            If search_cell.Value = orig(i) And search_cell.Offset(0, 1).Value = dest(i) Then
                
                    'If its the first match, init the array
                If (Not match_numbers) = -1 Then
                    ReDim Preserve match_numbers(0)
                    match_numbers(0) = flight_nums(i)
                Else
                    'Otherwise increment the array
                    ReDim Preserve match_numbers(UBound(match_numbers)   1)
                    match_numbers(UBound(match_numbers)) = flight_nums(i)
                End If
                
            End If
        Next i
        
        'If the array had found matches, store them; comma-delimited
        If Not Not match_numbers Then
            search_cell.Offset(0, 2).Value = Join(match_numbers, ",")
        End If
        
        Erase match_numbers
    Next search_cell
    

End Sub

CodePudding user response：

Here's an approach using Match() directly against the search values on the worksheet:

Sub Matches()
    
    Dim data, m As Long, rngOrigin As Range, rngDest As Range, m As Long, i As Long
    
    'one array of all data: origin|destination|flight#
    data = wsdata.Range("A2", wsdata.Cells(Rows.Count, "C").End(xlUp))
    'set search ranges
    Set rngOrigins = wsdata.Range("E2", wsdata.Cells(Rows.Count, "E").End(xlUp))
    Set rngDest = wsdata.Range("F2", wsdata.Cells(Rows.Count, "F").End(xlUp))
    'loop all source data
    For m = 1 To UBound(data, 1)
        'check Match() against search ranges
        If Not IsError(Application.Match(data(m, 1), rngOrigins, 0)) Then
            If Not IsError(Application.Match(data(m, 2), rngDest, 0)) Then
                i = i   1
                wsdata.Range("H1").Offset(i, 0).Resize(1, 3) = _
                        Array(data(m, 1), data(m, 2), data(m, 3))
            End If
        End If
    Next m

End Sub