Hello,

I'm using the BinarySearch algorithm to get the index of particular items in a sorted UDT array.

I want the index values of the first occurrence of three items in the UDT - column, row, objectType.

Only the first item I am after is correct.
(not coincidently I guess because this item is sorted first in the array)

Any guidance as to how to correct this?

Form1 Code:
Code:
Option Explicit


Private Sub Form_Load()

    Command1.Caption = "Run"

End Sub


Private Sub Command1_Click()

    Call LoadTestData01

    Dim o As Long   'object counter
    
    '-----------------------------------------------------------------------------------------
    ' Print obj for inspection (UNSORTED)

    Debug.Print "----------------------------------------------------------------------------"
    Debug.Print "obj() array UNSORTED"
    Debug.Print "----------------------------------------------------------------------------"
    Debug.Print "ndx          Column         Row                       ObjectType"
    For o = 1 To UBound(obj)
        Debug.Print "[" & o & "]", _
                    obj(o).Position.col, obj(o).Position.row, _
                    "|" & obj(o).objectType & "|"
    Next o
    '-----------------------------------------------------------------------------------------
    
    ' Sort obj array
    Call HeapSortGridObject(obj)
    
    '----------------------------------------------------------------------------------------
    ' Print obj for inspection (SORTED)
    
    Debug.Print "----------------------------------------------------------------------------"
    Debug.Print "obj() array SORTED"
    Debug.Print "----------------------------------------------------------------------------"
    Debug.Print "ndx          Column         Row                       ObjectType"
    For o = 1 To UBound(obj)
        Debug.Print "[" & o & "]", _
                    obj(o).Position.col, obj(o).Position.row, _
                    "|" & obj(o).objectType & "|"
    Next o
    '-----------------------------------------------------------------------------------------
    
    
    '-----------------------------------------------------------------------------------------
    ' Get Indexes
    
    Dim col As Long
    Dim row As Long
    Dim objectType As String
    
    col = 31
    row = 3
    objectType = "Bar"
    
    MsgBox "First occurrence of Column " & col & " at index " & _
           BinarySearchForColumn(obj, col)
    MsgBox "First occurrence of Row " & row & " at index " & _
           BinarySearchForRow(obj, row)
    MsgBox "First occurrence of objectType " & objectType & " at index " & _
           BinarySearchForObjectType(obj, objectType)
    '-------------------------------------------------------------------------------------------
    
End Sub


Private Sub LoadTestData01()

    ReDim obj(1 To 7)

    obj(1).Position.col = 322
    obj(1).Position.row = 7
    obj(1).objectType = "Note"
    
    obj(2).Position.col = 17
    obj(2).Position.row = 3
    obj(2).objectType = "Bar"
    
    obj(3).Position.col = 12
    obj(3).Position.row = 15
    obj(3).objectType = "Note"
    
    obj(4).Position.col = 48
    obj(4).Position.row = 12
    obj(4).objectType = "Bar"
    
    obj(5).Position.col = 19
    obj(5).Position.row = 8
    obj(5).objectType = "Note"
    
    obj(6).Position.col = 19
    obj(6).Position.row = 5
    obj(6).objectType = "Note"

    obj(7).Position.col = 31
    obj(7).Position.row = 6
    obj(7).objectType = "Note"

End Sub
Module1 Code:
Code:
Option Explicit


'-----------------------------------
Public Type GridPosition
    col As Long
    row As Long
End Type
'-----------------------------------

'-----------------------------------
Public Type GridObject
    objectType As String * 32
    Position As GridPosition
    glyphNum As Long
End Type

Public obj() As GridObject
'-----------------------------------
Module2 Code:
Code:
Option Explicit


'-----------------------------------------------------------------------------------------------
' Heap Sort Routines

' HeapSort (SiftDown) set for: 1-base/ascending/3-item sort

Public Sub HeapSortGridObject(ByRef Items() As GridObject)
    Dim last As Long
    Dim Temp As GridObject
    
    HeapifyGridObject Items, UBound(Items)
    For last = UBound(Items) To 2 Step -1
        Temp = Items(last)
        Items(last) = Items(1)
        Items(1) = Temp
        SiftDownGridObject Items, 1, last - 1
    Next
End Sub


Private Sub HeapifyGridObject(ByRef Items() As GridObject, _
                              ByVal count As Long)
    Dim Start As Long
    
    For Start = count \ 2 To 1 Step -1
        SiftDownGridObject Items, Start, count
    Next
End Sub


Private Sub SiftDownGridObject(ByRef Items() As GridObject, _
                               ByVal Start As Long, ByVal last As Long)
    Dim Root As Long
    Dim Child As Long
    Dim Swap As Long
    Dim Comp As Integer
    Dim Temp As GridObject
    
    '-------------------------------------------------------------------------------------------
    

    '-------------------------------------------------------------------------------------------
    ' Sort on 3 fields (.Position.Col then .Position.Row then .objectType)

    Root = Start
    Do While Root * 2 <= last
        Child = Root * 2
        Swap = Root
        Comp = Sgn(Items(Swap).Position.col - Items(Child).Position.col)
        If Comp = 0 Then
            Comp = Sgn(Items(Swap).Position.row - Items(Child).Position.row)
            If Comp = 0 Then
                Comp = Sgn(Items(Swap).objectType - Items(Child).objectType)
            End If
        End If
        If Comp < 0 Then Swap = Child
        If Child + 1 <= last Then
            Comp = Sgn(Items(Swap).Position.col - Items(Child + 1).Position.col)
            If Comp = 0 Then
                Comp = Sgn(Items(Swap).Position.row - Items(Child + 1).Position.row)
                If Comp = 0 Then
                    Comp = Sgn(Items(Swap).objectType - Items(Child + 1).objectType)
                End If
            End If
            If Comp < 0 Then Swap = Child + 1
        End If
        If Swap <> Root Then
            Temp = Items(Root)
            Items(Root) = Items(Swap)
            Items(Swap) = Temp
            Root = Swap
        Else
            Exit Do
        End If
    Loop
    '-------------------------------------------------------------------------------------------

    
End Sub
Module3 Code:
Code:
Option Explicit


Public Function BinarySearchForColumn(aSorted() As GridObject, key As Long) As Long

    ' (iterative) binary search algorithm (or half-interval search algorithm)
    ' finds position of a specified input value (search key) within an array sorted by key value
    
    ' algorithm modified to insert at leftmost position
    ' if the key value appears one or more times in the array
    
    Dim minIndex     As Long 'Integer
    Dim maxIndex     As Long 'Integer
    Dim midIndex     As Long 'Integer
    
    minIndex = 1 '0
    maxIndex = UBound(aSorted) - 1

    
    Do While minIndex <= maxIndex
        midIndex = Int((minIndex + maxIndex) / 2)
        If key <= aSorted(midIndex).Position.col Then
            maxIndex = midIndex - 1
        Else
            minIndex = midIndex + 1
        End If
    Loop
        
    ' key not found; insert at minIndex
    BinarySearchForColumn = minIndex

End Function


Public Function BinarySearchForRow(aSorted() As GridObject, key As Long) As Long

    ' (iterative) binary search algorithm (or half-interval search algorithm)
    ' finds position of a specified input value (search key) within an array sorted by key value
    
    ' algorithm modified to insert at leftmost position
    ' if the key value appears one or more times in the array
    
    Dim minIndex     As Long 'Integer
    Dim maxIndex     As Long 'Integer
    Dim midIndex     As Long 'Integer
    
    minIndex = 1 '0
    maxIndex = UBound(aSorted) - 1

    
    Do While minIndex <= maxIndex
        midIndex = Int((minIndex + maxIndex) / 2)
        If key <= aSorted(midIndex).Position.row Then
            maxIndex = midIndex - 1
        Else
            minIndex = midIndex + 1
        End If
    Loop
        
    ' key not found; insert at minIndex
    BinarySearchForRow = minIndex

End Function


Public Function BinarySearchForObjectType(aSorted() As GridObject, key As String) As Long

    ' (iterative) binary search algorithm (or half-interval search algorithm)
    ' finds position of a specified input value (search key) within an array sorted by key value
    
    ' algorithm modified to insert at leftmost position
    ' if the key value appears one or more times in the array
    
    Dim minIndex     As Long 'Integer
    Dim maxIndex     As Long 'Integer
    Dim midIndex     As Long 'Integer
    
    minIndex = 1 '0
    maxIndex = UBound(aSorted) - 1

    
    Do While minIndex <= maxIndex
        midIndex = Int((minIndex + maxIndex) / 2)
        If key <= aSorted(midIndex).objectType Then
            maxIndex = midIndex - 1
        Else
            minIndex = midIndex + 1
        End If
    Loop
        
    ' key not found; insert at minIndex
    BinarySearchForObjectType = minIndex

End Function