Error in heapsort algorithm

Question

I'm trying to write a heapsort algorithm and this is my code for it. However, it does not work. When I try to run the macro it says subscript is out of range and it corresponds to the if A(leftchild,1) > A(i,1) then bit. It says that both i and leftchild are equal to zero when that should not be the case but I don't know where to change it.

Sub MakeMaxHeap(i As Long, heapsize As Long)
    Dim LeftChild As Long
    Dim RightChild As Long
    Dim largest As Long

    LeftChild = 2 * i
    RightChild = 2 * i + 1

    If heapsize > LeftChild Then
        If A(LeftChild, 1) > A(i, 1) Then
            largest = LeftChild
        ElseIf A(LeftChild, 1) = A(i, 1) Then
            largest = i
        End If
    End If

    If heapsize > RightChild Then
        If A(RightChild, 1) > A(largest, 1) Then
            largest = RightChild
        ElseIf A(RightChild, 1) = A(largest, 1) Then
            largest = i
        End If
    End If

    If largest <> i Then
        Call MakeMaxHeap(largest, heapsize)
    End If

End Sub

Sub BuildMaxHeap()
    Dim i As Long
    Dim heapsize As Long
    heapsize = n

    For i = n / 2 To 1 Step -1
        Call MakeMaxHeap(i, heapsize)
    Next i

End Sub


Sub HeapSort()
    Dim i As Long
    Dim temp As Double
    Dim j As Long
    Dim heapsize As Long

    Call InitializeA
    'This basically stores a
    Call BuildMaxHeap
    heapsize = n
    For i = n To 2 Step -1
        temp = A(i, 1)
        A(i, 1) = A(1, 1)
        A(1, 1) = temp
        heapsize = heapsize - 1
        Call MakeMaxHeap(1, heapsize)
    Next i

    For j = 1 To n
        Cells(j, 7).Value = A(j, 1)
    Next j
End Sub

Answer 1

The MakeMaxHeap procedure has a few issues:

• At some point the variable largest will never get a value, since both If conditions could be False. If that happens the recursive call is made with a first argument that is 0, leading to the run time error you got.

• Although comparisons and recursive calls are made, MakeMaxHeap actually does not change anything to the array. Values should be swapped to make it a max heap.

Here is the corrected code for MakeMaxHeap with comments where changes were made:

Sub MakeMaxHeap(i As Long, heapsize As Long)
    Dim LeftChild As Long
    Dim RightChild As Long
    Dim largest As Long
    Dim temp As Long ' *** Added

    LeftChild = 2 * i
    RightChild = 2 * i + 1

    ' *** Give the variable an initial value, as both If conditions might be false
    largest = i
    ' *** Use >= instead of >
    If heapsize >= LeftChild Then
        If A(LeftChild, 1) > A(i, 1) Then
            largest = LeftChild
        ' *** ElseIf is not needed
        End If
    End If

    ' *** Use >= instead of >
    If heapsize >= RightChild Then
        If A(RightChild, 1) > A(largest, 1) Then
            largest = RightChild
        ' *** ElseIf is not needed
        End If
    End If

    If largest <> i Then
        ' *** You need to actually swap the values
        temp = A(i, 1)
        A(i, 1) = A(largest, 1)
        A(largest, 1) = temp
        Call MakeMaxHeap(largest, heapsize)
    End If    
End Sub