Search in arrays (binary)
2020-07-23 Searching 0 354
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