Excel VBA binary search class module [closed]

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: " & GetTickCount - startTickCount & " 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: " & GetTickCount - startTickCount & " 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.