Converting ascending array sort to descending VBA

Question

I have this function that uses median of three method to sort a single dimension array in VBA, I tried to make it to sort descending, but somehow I am missing a part. Is there a simple way to achieve this?

Public Sub MedianThreeQuickSort1Desc(ByRef pvarArray As Variant, _
                                    Optional ByVal plngLeft As Long, _
                                        Optional ByVal plngRight As Long)

    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim lngIndex As Long
    Dim varSwap As Variant
    Dim a As Long
    Dim b As Long
    Dim c As Long

    If plngRight = 0 Then
        plngLeft = LBound(pvarArray)
        plngRight = UBound(pvarArray)
    End If

    lngFirst = plngLeft
    lngLast = plngRight
    lngIndex = plngRight - plngLeft + 1
    a = Int(lngIndex * Rnd) + plngLeft
    b = Int(lngIndex * Rnd) + plngLeft
    c = Int(lngIndex * Rnd) + plngLeft
    If pvarArray(a) <= pvarArray(b) And pvarArray(b) <= pvarArray(c) Then
        lngIndex = b
    Else
        If pvarArray(b) <= pvarArray(a) And pvarArray(a) <= pvarArray(c) Then
            lngIndex = a
        Else
            lngIndex = c
        End If
    End If

    varMid = pvarArray(lngIndex)
    Do
        Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
            lngFirst = lngFirst + 1
        Loop

        Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
            lngLast = lngLast - 1
        Loop

        If lngFirst <= lngLast Then
            varSwap = pvarArray(lngFirst)
            pvarArray(lngFirst) = pvarArray(lngLast)
            pvarArray(lngLast) = varSwap
            lngFirst = lngFirst + 1
            lngLast = lngLast - 1
        End If
    Loop Until lngFirst > lngLast

    If (lngLast - plngLeft) < (plngRight - lngFirst) Then
        If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
        If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
    Else
        If lngFirst < plngRight Then MedianThreeQuickSort1 pvarArray, lngFirst, plngRight
        If plngLeft < lngLast Then MedianThreeQuickSort1 pvarArray, plngLeft, lngLast
    End If
End Sub

Testing sub:

Sub TryIt()
    Dim i As Integer
    Dim arr As Variant

    arr = Array("Apple", "word", 4, "Jack", 521, "123", 1, 2, 3, 0)

    Call MedianThreeQuickSort1(arr)
    For i = 0 To UBound(arr)
        Debug.Print arr(i) & " "
    Next i
End Sub

Output:

0 
1 
2 
3 
4 
521 
123 
Apple 
Jack 
word

Maybe this project can give you some ideas (they don't implement a descending sort but the algorithm is really impressive) — Ricardo Diaz
– Ricardo Diaz, Commented Jan 11, 2020 at 1:27
Friendly hint: call the sub procedure argument without brackets: MedianThreeQuickSort1 arr to preserve the ByRef accessibility. BTW Can you edit the working ascending sort code to see what and where you made changes in code? — T.M.
– T.M., Commented Jan 12, 2020 at 19:18

Ibo · Accepted Answer · 2020-01-14 01:58:28Z

1

Turns out it was not that hard:

Public Sub MedianThreeQuickSort1_Desc(ByRef pvarArray As Variant, _
                                    Optional ByVal plngLeft As Long, _
                                        Optional ByVal plngRight As Long)

    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim lngIndex As Long
    Dim varSwap As Variant
    Dim a As Long
    Dim b As Long
    Dim c As Long

    If plngRight = 0 Then
        plngLeft = LBound(pvarArray)
        plngRight = UBound(pvarArray)
    End If

    lngFirst = plngLeft
    lngLast = plngRight
    lngIndex = plngRight - plngLeft + 1
    a = Int(lngIndex * Rnd) + plngLeft
    b = Int(lngIndex * Rnd) + plngLeft
    c = Int(lngIndex * Rnd) + plngLeft
    If pvarArray(a) <= pvarArray(b) And pvarArray(b) <= pvarArray(c) Then
        lngIndex = b
    Else
        If pvarArray(b) <= pvarArray(a) And pvarArray(a) <= pvarArray(c) Then
            lngIndex = a
        Else
            lngIndex = c
        End If
    End If

    varMid = pvarArray(lngIndex)
    Do
        Do While pvarArray(lngFirst) > varMid And lngFirst < plngRight
            lngFirst = lngFirst + 1
        Loop

        Do While varMid > pvarArray(lngLast) And lngLast > plngLeft
            lngLast = lngLast - 1
        Loop

        If lngFirst <= lngLast Then
            varSwap = pvarArray(lngLast)
            pvarArray(lngLast) = pvarArray(lngFirst)
            pvarArray(lngFirst) = varSwap
            lngFirst = lngFirst + 1
            lngLast = lngLast - 1
        End If
    Loop Until lngFirst > lngLast

    If (lngLast - plngLeft) < (plngRight - lngFirst) Then
        If plngLeft < lngLast Then MedianThreeQuickSort1_Desc pvarArray, plngLeft, lngLast
        If lngFirst < plngRight Then MedianThreeQuickSort1_Desc pvarArray, lngFirst, plngRight
    Else
        If lngFirst < plngRight Then MedianThreeQuickSort1_Desc pvarArray, lngFirst, plngRight
        If plngLeft < lngLast Then MedianThreeQuickSort1_Desc pvarArray, plngLeft, lngLast
    End If
End Sub

Example:

Sub TryIt()
    Dim i As Integer
    Dim arr As Variant

    arr = Array("Apple", "word", 4, "Jack", 521, "123", 1, 2, 3, 0)

    Call MedianThreeQuickSort1_Desc(arr)
    For i = 0 To UBound(arr)
        Debug.Print arr(i) & " "
    Next i
End Sub

Output:

word 
Jack 
Apple 
123 
521 
4 
3 
2 
1 
0

answered Jan 14, 2020 at 1:58

Ibo

4,3197 gold badges51 silver badges75 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

T.M. Over a year ago

Are you sure to get the above output? - Mine results in Apple|word|4|Jack|521|123|1|2|3|0. - BTW You could shorten code by Debug.Print Join(arr, "|") instead of a loop through each item :)

Ibo Over a year ago

@T.M. 1- Yeah, I ran it again and I am getting what I have posted. Did you use the sub that has _Desc at the end of its name? I tried it with 3 different items and I am getting the right answer. 2- I wanted to copy paste the answer from the immediate window and have one item per line, Join is shorter, thanks though!

T.M. Over a year ago

If a Call statement is specified, you must enclose argumentlist in parentheses. - Trying out your answer, I killed the Call statement as I don't use it, but forgot to remove the brackets for this direct call. If a proc is used without Call but with parentheses, it's a dangerous thing as there can happen sort of evaluation (e.g. ranges) or a possible ByVal transformation of ByRef arguments. So a correct direct call is MedianThreeQuickSort1_Desc arr without parentheses to receive the same output ~> word|Jack|Apple|123|521|4|3|2|1|0 and apologize myself :-)

T.M. Over a year ago

FYI Wyh is the call keyword required ...?, citation: "Call is never required. In fact it's been obsolete since the advent of implicit call syntax in... Visual Basic 4.0, if I recall correctly."

Ibo Over a year ago

I always use call. If you don't need the output of a function you can use call and run the function. Using call helps to easily recognize the routine calls in code lines.

Collectives™ on Stack Overflow

Converting ascending array sort to descending VBA

1 Answer 1

5 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related