Search in arrays (binary)

 2020-07-23    Searching    0    27

With the functions below you can search for an item in a one- or two-dimensional array that is sorted in ascending order.
Searching for an item in an ascending sorted array using a binary search is significantly faster than using a linear search.
If your array can't be sorted in ascending order you can use a linear search, but it will probably be very slow if the array you are searching is large or you perform many searches.

Function Array_BinaryMatch(varArray As Variant, varFind As Variant, Optional blnHasHeader As Boolean = False) As Long
' updated 2008-04-30 by OPE
' performs a binary search in a one-dimensional array sorted in ascending order
' returns the index for the first item that matches varFind
' returns -1 if varArray is not an array or if varFind was not found in varArray, optionally LBound(varArray) - 1 if LBound(varArray) <= -1
' example: i = Array_BinaryMatch(varArray, 1234)
' example: i = Array_BinaryMatch(varArray, "somethingtofind")
Dim lngLower As Long, lngMiddle As Long, lngUpper As Long, i As Long
    Array_BinaryMatch = -1
    If Not IsArray(varArray) Then Exit Function ' no array
    If Len(varFind) = 0 Then Exit Function ' nothing to find
    
    If LBound(varArray) <= -1 Then Array_BinaryMatch = LBound(varArray) - 1
    i = UBound(varArray) - LBound(varArray) + 1 ' array items count
    If blnHasHeader Then
        If i < 2 Then Exit Function ' no array items
    Else
        If i < 1 Then Exit Function ' no array items
    End If
    
    ' determine upper and lower bounds
    lngLower = LBound(varArray, 1)
    lngUpper = UBound(varArray, 1)
    If blnHasHeader Then lngLower = lngLower + 1
    
    Do While lngLower < lngUpper
        lngMiddle = (lngLower + lngUpper) \ 2 ' the middle item (floor)
        If varArray(lngMiddle) < varFind Then
            lngLower = lngMiddle + 1
        Else
            lngUpper = lngMiddle
        End If
    Loop
    If varArray(lngLower) = varFind Then
        Array_BinaryMatch = lngLower
    End If
End Function

Function Array_BinaryMatch2(varArray As Variant, varFind As Variant, Optional lngCompareColumn As Long = -1, Optional blnHasHeader As Boolean = False) As Long
' updated 2008-04-30 by OPE
' performs a binary search in a two-dimensional array sorted in ascending order on column lngCompareColumn
' returns the index for the first item in column lngCompareColumn that matches varFind
' lngCompareColumn: must be a value >= LBound(varArray, 2) and <= UBound(varArray, 2)
' if lngCompareColumn < 0 then LBound(varArray, 2) (the first column) will be used
' returns -1 if varArray is not an array or if varFind was not found in varArray, optionally LBound(varArray, 1) - 1 if LBound(varArray, 1) <= -1
' example: i = Array_BinaryMatch2(varArray, 1234, 1)
' example: i = Array_BinaryMatch2(varArray, "somethingtofind", 2)
Dim lngLower As Long, lngMiddle As Long, lngUpper As Long, i As Long
    Array_BinaryMatch2 = -1
    If Not IsArray(varArray) Then Exit Function ' no array
    If Len(varFind) = 0 Then Exit Function ' nothing to find
    
    If LBound(varArray, 1) <= -1 Then Array_BinaryMatch2 = LBound(varArray, 1) - 1
    i = UBound(varArray, 1) - LBound(varArray, 1) + 1 ' array items count
    If blnHasHeader Then
        If i < 2 Then Exit Function ' no array items
    Else
        If i < 1 Then Exit Function ' no array items
    End If
    
    ' determine upper and lower bounds
    lngLower = LBound(varArray, 1)
    lngUpper = UBound(varArray, 1)
    If blnHasHeader Then lngLower = lngLower + 1
    
    If lngCompareColumn < 0 Then lngCompareColumn = LBound(varArray, 2)
    If lngCompareColumn < LBound(varArray, 2) Or lngCompareColumn > UBound(varArray, 2) Then Exit Function
    
    Do While lngLower < lngUpper
        lngMiddle = (lngLower + lngUpper) \ 2 ' the middle item (floor)
        If varArray(lngMiddle, lngCompareColumn) < varFind Then
            lngLower = lngMiddle + 1
        Else
            lngUpper = lngMiddle
        End If
    Loop
    If varArray(lngLower, lngCompareColumn) = varFind Then
        Array_BinaryMatch2 = lngLower
    End If
End Function