Here is what I came up with for a binary search of an array. It allows for searching one or many columns to match. It assumes that array being searched is sorted with the same sort priorities as the order in which the parameters are submitted.
It seems to work well but any advice on performance or structure would be appreciated.
Option Explicit
Option Compare Text
Private Function BinFind(inArray As Variant, hasHeader As Boolean, ParamArray WhatValueWhatColumn() As Variant) As Long
'== =============================================================================================================
'== conducts a binary tree search in a 1 or 2 dimensional array
'==
'== looks for matches defined in 'WhatValueWhatColumn'
'== supports matching of multiple columns.
'==
'== each ParamArray pair submitted must be an array stating what is being seeked and in which column it is found
'== i.e. BinFind(arr1, True, Array(firstName, 2), Array(lastName, 1), Array(birthdate, 6))
'==
'== the array being searched, 'inArray' must be sorted in ascending order
'== where the sort priority matches the order of the 'WhatValueWhatColumn' submissions
'==
'== {TODO} - test that array is sorted correctly prior to execution, raise error if not.
'== =============================================================================================================
Dim High As Long 'highest boundary of range being searched
Dim Low As Long 'lowest boundary of range being searched
Dim Mid As Long 'current split point
Dim v As Variant 'WhatValueWhatColumn variant
Dim found As Boolean
'== initialize lower and upper bounds
High = UBound(inArray)
Low = LBound(inArray) - hasHeader
'== test to see if the primary column is outside the lower or upper bounds of the entire test array
v = WhatValueWhatColumn(0)
If v(0) < inArray(Low, v(1)) Or v(0) > inArray(High, v(1)) Then
BinFind = -1
Exit Function
End If
'== loop through all records, walking low and high in until the correct record is found
'== or it is determined that the record is not in the array
Do
'== determine the middle record of the dataset
Mid = (High + Low) / 2
'== test each column by priority
'== if it is a match check the next column in the sequence
'== if it is not a match then move the appropriate
'== boundary to the mid position
'== if all columns match then the record is found!
For Each v In WhatValueWhatColumn
If inArray(Mid, v(1)) = v(0) Then
found = True
Else
found = False
If Low = High Then
Exit Do
ElseIf inArray(Mid, v(1)) > v(0) Then
High = Application.Max(Mid - 1, Low)
Else
Low = Application.Min(Mid + 1, High)
End If
Exit For
End If
Next v
Loop Until found
If found Then
BinFind = Mid
Else
BinFind = -1
End If
End Function
Here is the test I used in Excel. adjust as necessary
'#################################
'## TEST
'#################################
Sub testBinFind()
Dim arr1 As Variant
Dim arr2 As Variant
Dim i As Long
Dim index As Long
With ThisWorkbook
'== the array we are going to look for stuff in
arr1 = .Sheets("Array1").UsedRange
'== the array we are defining what we are looking for from and pasting data back to
arr2 = .Sheets("Array2").UsedRange
End With
For i = LBound(arr2) + 1 To UBound(arr2) 'LBound(arr2) + 1 skips the headers
'== Identify some columns that need to be matched
'== makes it easier to see what's going on when submitting Params to BinFind
Dim lastName As String: firstName = arr2(i, 1)
Dim firstName As String: lastName = arr2(i, 2)
Dim dedCd As String: dedCd = arr2(i, 3)
'== Here we go!
index = BinFind(arr1, True, _
Array(firstName, 1), _
Array(lastName, 2), _
Array(dedCd, 3))
'== if a match was found, post it back to the final array
If index > 0 Then
arr2(i, 4) = arr1(index, 4)
End If
Next i
'== post the array back to the sheet
With ThisWorkbook.Sheets("Array2")
.UsedRange.Value = arr2
.ListObjects.Add xlSrcRange, .UsedRange, xlYes
End With
End Sub
