Excel VBA binary search class module I have a long list of sorted strings in a Workbook, and I have to find a lot of values in it. I was hoping to build a binary search Class Module that will find them for me faster than Excel's built-in search formulas/methods.

Can anyone think of a faster way, or maybe more bug proof?

Values() As String
Value2 as String
Upper As Integer
Lower As Integer
Middle As Integer
Private Function Move_Array() As Integer
    Middle = Round((Upper - Lower) / 2, 0)
    Move_Array = Compare(Values(Middle), Value2)
End Function
Function Search(Cells As Range, Value As String) As Integer
    If Cells.Count &lt; 1 Then
        Values() = Cells.value
    End If
Value2 = Value
Again:
    Select Case Move_Array()
        Case -1
            Lower = Middle
        Case 1
            Upper = Middle
        Case 0
            Search = Middle
            Exit Function
    End Select
    GoTo Again
End Function


This is a Sub that would call this class. However, this is subject to change.

Sub Start_BINSearch()
    Dim Search_operation As BINSearch
    Dim Cells As Range
    Dim Value As String

    Set Search_operation = BINSearch
    Set Cells = Application.InputBox( _
        Prompt:="Enter Range to Search", _
        Type:=8)
    Value = Application.InputBox( _
        Prompt:="Enter value that you waant to look for")
    Position = Search_operation.Search(Cells, Value)
End Sub
Your code is quite difficult to manipulate into doing what you are trying to do. 

Some specifics:


Don't use "goto" whenever possible


The following needs to be fixed:

   Dim Search_operation As BINSearch
   'Set Search_operation = BINSearch
   Set Search_operation = New BINSearch


When working with objects, you need to use New when using Set.

This is currently not handling any errors or anything for your input ranges.

Set Cells = Application.InputBox( _
    Prompt:="Enter Range to Search", _
    Type:=8)
Value = Application.InputBox( _
    Prompt:="Enter value that you waant to look for")
Position = Search_operation.Search(Cells, Value)


When you want to use global variables (which, while there are cases to use them, this is not one of them)  you need to dimension them still. Plus, the way you had them before won't compile anyways...

Public Value2 as String
Public Upper As Integer
Public Lower As Integer
Public Middle As Integer


I don't recommend this at all because it is hard to read.



The following does the random search the way you are looking for. I also added a comparison vs .Find to make it easier. I used the animal list here. This is the pastebin.

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long

Private Function getRandomSearchArray(ByRef arr, wsRange As Range, ByVal numbAttempts As Long) As Variant

    ReDim arr(0 To numbAttempts)
    Dim wsArr
    wsArr = wsRange.Value

    Dim i As Long
    Dim rand As Double

    For i = LBound(arr) To UBound(arr)
        rand = Round(rnd() * (UBound(wsArr) - LBound(wsArr)), 0) + 1
        arr(i) = wsArr(rand, 1)
    Next i


End Function

Sub myBinarySearchExample()

    Dim searchRange As Range
    Dim sortedValues As Variant
    Dim searchValues As Variant
    Dim startTickCount As Double
    Dim numbAttempts As Long
    Dim i As Long
    Dim s As String
    Dim arrIndex As Integer


    Set searchRange = Worksheets("BinSearch").Range("A1:A141")
    numbAttempts = 100000

    sortedValues = searchRange.Value
    getRandomSearchArray searchValues, searchRange, numbAttempts

    startTickCount = GetTickCount

    'using Binary Search
    For i = 1 To numbAttempts
        s = searchValues(i)
        'Do this to simulate the "read into memory" each iteration
        sortedValues = searchRange.Value

        arrIndex = BinarySearch(sortedValues, s)
    Next i

    Debug.Print "It took: " &amp; GetTickCount - startTickCount &amp; " ms to run this with the Binary Search."


    'do with .Find
    startTickCount = GetTickCount

    For i = 1 To numbAttempts

        arrIndex = searchRange.Find(What:=searchValues(i), After:=Range("A1"), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Row


    Next i

    Debug.Print "It took: " &amp; GetTickCount - startTickCount &amp; " ms to run this with the Excel Find."

End Sub




Function BinarySearch(searchArray As Variant, searchValue As String) As Integer

    'dimension these as long to avoid possible integer
    'overflow errors for large lists
    Dim curIndex As Long
    Dim firstIndex As Long
    Dim lastIndex As Long

    Dim nextMiddle As Long
    Dim strValue As String

    'set lower/upper bounds correctly initially for the search
    firstIndex = LBound(searchArray)
    lastIndex = UBound(searchArray)


    Do

        nextMiddle = Round((lastIndex - firstIndex) / 2 + firstIndex)

        strValue = searchArray(nextMiddle, 1)

        'check if it is before/after the current point
        If StrComp(searchValue, strValue, vbTextCompare) = -1 Then
            lastIndex = nextMiddle - 1
        ElseIf StrComp(searchValue, strValue, vbTextCompare) = 1 Then
            firstIndex = nextMiddle + 1
        Else
            BinarySearch = nextMiddle
            Exit Do
        End If


    Loop




End Function




It took: 3182 ms to run this with the Binary Search.
It took: 11763 ms to run this with the Excel Find.