Search values in a two dimensional array with multiple criteria - arrays

Question

Suppose I have the following table with three columns. I want to search for an exact match or next previous date from Column3, conditional to Column1 being a given value.
This can be easily done with XLOOKUP. However, I need to do so in VBA because I'll show the date found in a userform Textbox to the user. From what I have searched so far, Application.Worksheetfunction.Xlookup won't work with an & for multiple criteria, so the solution for this would involve manipulating arrays.
I created a variant from that table by writing:
Dim TBL As ListObject
Set TBL = Sheets("sheet1").ListObjects("Table1")
Dim DirArray As Variant
DirArray = TBL.DataBodyRange
Any advice on how to get that approximate match using arrays?

Answer 1

Using an array of values will be faster than referencing a cell for each check - esp. if your table is much larger.
You can use this function - it will return 0 in case no valid date is found.
As I am using sortBy you will need Excel 365 for this to work.
By using SortBy it is safe to exit the for-loop in case we have found a matching date.
Public Function nearestDate(lo As ListObject, valueColumn1 As String, valueColumn3 As Date) As Date
Dim arrValues As Variant
arrValues = Application.WorksheetFunction.SortBy(lo.DataBodyRange, lo.ListColumns(1).DataBodyRange, 1, lo.ListColumns(3).DataBodyRange, 1)
Dim i As Long
For i = 1 To UBound(arrValues, 1)
If arrValues(i, 1) = valueColumn1 Then
If arrValues(i, 3) = valueColumn3 Then
'we found what we are looking for
nearestDate = arrValues(i, 3)
ElseIf arrValues(i, 3) < valueColumn3 Then
'we have to check next row - if there is one
If i < UBound(arrValues, 1) Then
If arrValues(i + 1, 1) = valueColumn1 And arrValues(i + 1, 3) > valueColumn3 Then
'same column1 but column3 greater than valueColumn3
nearestDate = arrValues(i, 3)
ElseIf arrValues(i + 1, 1) <> valueColumn1 Then
'new column1 value --> therefore we take current date
nearestDate = arrValues(i, 3)
End If
Else
'last value --> ok
nearestDate = arrValues(i, 3)
End If
End If
End If
If nearestDate > 0 Then Exit For
Next
End Function
You can call this function like this:
Public Sub test()
Dim ws As Worksheet: Set ws = Thisworkbook.Worksheets("sheet1")
Dim lo As ListObject: Set lo = ws.ListObjects("Table1")
Dim valueColumn1 As String: valueColumn1 = ws.Range("F1")
Dim valueColumn3 As Date: valueColumn3 = ws.Range("F2")
Debug.Print nearestDate(lo, valueColumn1, valueColumn3)
End Sub

Answer 2

There may well be a neater answer, but here is a simple brute-force function that just scans down every row in the given data looking for the closest match to the given criteria. The function returns the date of the closest match, but maybe it would be more useful to you if it returned, say, the row number of the row that is the closest match. Put this function in a new code module so that it can be called as a function from a cell, for example =findEntryByCol1andCol3(Table1,F1,F2)
Option Explicit
Public Function findEntryByCol1andCol3(dataToSearch As Range, findCol1, findCol3) As Variant
'// variable to hold the row with the closest match to criteria
Dim matchRow As Range
Set matchRow = Nothing
'// variable to hold the row being checked
Dim checkRow As Range
Dim ix As Long
For ix = 1 To dataToSearch.Rows.Count
'// get the next row to be checked
Set checkRow = dataToSearch.Rows(ix)
'// does column 1 in this row match the search criterion for column 1?
If checkRow.Cells(1, 1).Value = findCol1 Then
'// now see if the date in the row is less than the search date
If findCol3 >= checkRow.Cells(1, 3).Value Then
'// If there has been no match then use this checked row as the first found match
If matchRow Is Nothing Then
Set matchRow = checkRow
'// If there has been a previous match check
'// if the new date is later that the previously found date
ElseIf matchRow.Cells(1, 3).Value < checkRow.Cells(1, 3).Value Then
Set matchRow = checkRow
End If
End If
Else
End If
Next ix
'// Now return the result of the search
If matchRow Is Nothing Then
findEntryByCol1andCol3 = "Not found"
Else
findEntryByCol1andCol3 = matchRow.Cells(1, 3)
End If
End Function