Efficeint Search Array Function

mrhopko

Board Regular
Joined
Jan 31, 2012
Messages
68
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
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Kyle123

Well-known Member
Joined
Jan 24, 2012
Messages
2,720
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:
Code:
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

Well-known Member
Joined
Jun 17, 2011
Messages
2,189
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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:
Code:
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

Well-known Member
Joined
Jan 24, 2012
Messages
2,720
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
 
Last edited:

taurean

Well-known Member
Joined
Jun 17, 2011
Messages
2,189
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

MrExcel MVP
Joined
Feb 14, 2002
Messages
85,209
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).
 

Forum statistics

Threads
1,144,369
Messages
5,723,950
Members
422,527
Latest member
TotalBeginner201

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top