Efficeint Search Array Function

[mrhopko]

Hi Team

I'm trying to write an efficient search function with the following definitions:

• Searches one SORTED column (lArrayCol)
• looks for one element (dFindme)
• in a 2 dimensional array(vaArray)
• Returns 0 if element not found
• returns element number in column if found

I have written two versions, one for strings and one for numbers. The one for numbers is below.

Can anyone increase the efficiency of this code?



Function FndAryNmbr(dFindme As Double, vaArray As Variant, lArrayCol As Long) As Long

'searches for an element in an array column. returns the elementnumber
'returns the element number if found. returns 0 if not
'the array column being searched must be sorted

Dim llsplit As Long
Dim llSearchElement As Long

llSearchElement = WorksheetFunction.RoundUp(UBound(vaArray, 1) / 2, 0)
llsplit = 1

Do While dFindme <> vaArray(llSearchElement, lArrayCol)
llsplit = llsplit + 1

If dFindme > vaArray(llSearchElement, lArrayCol) Then
llSearchElement = llSearchElement + WorksheetFunction.RoundUp(UBound(vaArray, 1) / 2 ^ llsplit, 0)
Else
llSearchElement = llSearchElement - WorksheetFunction.RoundUp(UBound(vaArray, 1) / 2 ^ llsplit, 0)
End If

If (llSearchElement > UBound(vaArray, 1)) Then
llSearchElement = UBound(vaArray, 1)
End If

If (llSearchElement < 1) Then
llSearchElement = 1
End If

If (WorksheetFunction.RoundUp(UBound(vaArray, 1) / 2 ^ llsplit, 0) = 1) And _
(WorksheetFunction.RoundUp(UBound(vaArray, 1) / 2 ^ (llsplit - 1), 0) = 1) Then
FndAryNmbr = 0
Exit Function
End If
Loop

FndAryNmbr = llSearchElement
End Function

 

[Kyle123]

I didn't write it (but I've adapted it for 2 dimensions) and I'm not sure where I got it from, but this is faster over 70,000 elements:

Function dhBinarySearch(varItems As Variant, VarSought As Variant, lnColumn As Long) As Long    
    Dim lnLower As Long
    Dim lnMiddle As Long
    Dim lnUpper As Long
    
    lnLower = LBound(varItems)
    lnUpper = UBound(varItems)
    
    Do While lnLower < lnUpper
        lnMiddle = (lnLower + lnUpper) \ 2
        If VarSought > varItems(lnMiddle, lnColumn) Then
            lnLower = lnMiddle + 1
        Else
            lnUpper = lnMiddle
        End If
    Loop
    
    If varItems(lnLower, lnColumn) = VarSought Then
        dhBinarySearch = lnLower
    Else
        dhBinarySearch = -1
    End If
    
End Function

 

[taurean]

I didn't write it (but I've adapted it for 2 dimensions) and I'm not sure where I got it from, but this is faster over 70,000 elements:

Function dhBinarySearch(varItems As Variant, VarSought As Variant, lnColumn As Long) As Long    
    Dim lnLower As Long
    Dim lnMiddle As Long
    Dim lnUpper As Long
    
    lnLower = LBound(varItems)
    lnUpper = UBound(varItems)
    
    Do While lnLower < lnUpper
        lnMiddle = (lnLower + lnUpper) \ 2
        If VarSought > varItems(lnMiddle, lnColumn) Then
            lnLower = lnMiddle + 1
        Else
            lnUpper = lnMiddle
        End If
    Loop
    
    If varItems(lnLower, lnColumn) = VarSought Then
        dhBinarySearch = lnLower
    Else
        dhBinarySearch = -1
    End If
    
End Function

Seems to be from VBA Developer's Handbook. I have a paperback so can't put finger on it. They have used the prefix "dh" in the codes.

 

[Kyle123]

ah, that would make sense, I have a virtual copy of it somewhere since I couldn't get my hands on a paper version. I should probably take the code down then since it will be copywrighted - I can't however edit my post

 

[taurean]

I'd hope there shall be no violation of the copyright issue as the codes were meant to be reused (which is what I think I'd read somewhere in the book).

 

[Aladin Akyurek]

ah, that would make sense, I have a virtual copy of it somewhere since I couldn't get my hands on a paper version. I should probably take the code down then since it will be copywrighted - I can't however edit my post

I'd hope there shall be no violation of the copyright issue as the codes were meant to be reused (which is what I think I'd read somewhere in the book).

Since it's not mentioned or implicated as one's own, no intended breaching involved.

I guess it implements a binary search. Comparing its behavior with Excel's would be nice for LOOKUP and kindred functions use such an algorithm...

Provided that MatchVector is in ascending order:

LOOKUP(LValue,MatchVector,ResultVector)

IF(LOOKUP(LValue,MatchVector)=LValue,LOOKUP(LValue,MatchVector,ResultVector),"")

The 2nd does effect a fast exact match.

See for more:

http://www.mrexcel.com/forum/excel-questions/310278-vlookup-multiple-matches-match-returned.html (post #7).