Solved

VBA sort routine not always working

Posted on 2014-01-15
2
430 Views
Last Modified: 2014-01-15
Driving me nuts.  Below is a sort routine written in ACCESS VBA.  Below that are two routines to test it.
The first routine works fine, but nothing in the second routine gets sorted.
Help!




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Sort a 2-dimensional array on either dimension
' Omit plngLeft & plngRight; they are used internally during recursion
' Sample usage to sort on column 4
' Dim MyArray(1 to 1000, 1 to 5) As Long
' QuickSort2 MyArray, 2, 4
' Dim MyArray(1 to 5, 1 to 1000) As Long
' QuickSort2 MyArray, 1, 4
Public Sub QuickSort2(ByRef pvarArray As Variant, plngDim As Long, plngCol As Long, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim varSwap As Variant
    Dim c As Long
    Dim cMin As Long
    Dim cMax As Long
    
    cMin = LBound(pvarArray, plngDim)
    cMax = UBound(pvarArray, plngDim)
    Select Case plngDim
        Case 1
            If plngRight = 0 Then
                plngLeft = LBound(pvarArray, 2)
                plngRight = UBound(pvarArray, 2)
            End If
            lngFirst = plngLeft
            lngLast = plngRight
            varMid = pvarArray(plngCol, (plngLeft + plngRight) \ 2)
            Do
                Do While pvarArray(plngCol, lngFirst) < varMid And lngFirst < plngRight
                    lngFirst = lngFirst + 1
                Loop
                Do While varMid < pvarArray(plngCol, lngLast) And lngLast > plngLeft
                    lngLast = lngLast - 1
                Loop
                If lngFirst <= lngLast Then
                    For c = cMin To cMax
                        varSwap = pvarArray(c, lngFirst)
                        pvarArray(c, lngFirst) = pvarArray(c, lngLast)
                        pvarArray(c, lngLast) = varSwap
                    Next
                    lngFirst = lngFirst + 1
                    lngLast = lngLast - 1
                End If
            Loop Until lngFirst > lngLast
            'Debug.Print "ll"
            If plngLeft < lngLast Then QuickSort2 pvarArray, plngDim, plngCol, plngLeft, lngLast
            If lngFirst < plngRight Then QuickSort2 pvarArray, plngDim, plngCol, lngFirst, plngRight
        Case 2
            If plngRight = 0 Then
                plngLeft = LBound(pvarArray, 1)
                plngRight = UBound(pvarArray, 1)
            End If
            lngFirst = plngLeft
            lngLast = plngRight
            varMid = pvarArray((plngLeft + plngRight) \ 2, plngCol)
            Do
                Do While pvarArray(lngFirst, plngCol) < varMid And lngFirst < plngRight
                    lngFirst = lngFirst + 1
                Loop
                Do While varMid < pvarArray(lngLast, plngCol) And lngLast > plngLeft
                    lngLast = lngLast - 1
                Loop
                If lngFirst <= lngLast Then
                    For c = cMin To cMax
                        varSwap = pvarArray(lngFirst, c)
                        pvarArray(lngFirst, c) = pvarArray(lngLast, c)
                        pvarArray(lngLast, c) = varSwap
                    Next
                    lngFirst = lngFirst + 1
                    lngLast = lngLast - 1
                End If
            Loop Until lngFirst > lngLast
            If plngLeft < lngLast Then QuickSort2 pvarArray, plngDim, plngCol, plngLeft, lngLast
            If lngFirst < plngRight Then QuickSort2 pvarArray, plngDim, plngCol, lngFirst, plngRight
    End Select
GoTo EndSub:

ERROR_QuickSort2:
Stop

EndSub:
End Sub

Sub testSort()
    Dim a(8, 1) As Variant
    a(0, 0) = 3: a(0, 1) = "asdf"
    a(1, 0) = 6: a(1, 1) = "ss"
    a(2, 0) = 1: a(2, 1) = "tre"
    QuickSort2 a(), 2, 0
    Stop
End Sub

Sub testSort2()
    Dim Mapping(10, 1) As Variant
    Mapping(0, 0) = 3
    Mapping(0, 1) = "df"
    Mapping(1, 0) = 1
    Mapping(1, 1) = "ssdf"
    QuickSort2 Mapping(), 1, 0
    Stop
End Sub

Open in new window

0
Comment
Question by:rrhandle8
2 Comments
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
ID: 39784114
You call the sort routine with different arguments the 2nd time.

If you call it with the same arguments as you did the first time it will sort.
Sub testSort2()
    Dim Mapping(10, 1) As Variant
    Mapping(0, 0) = 3
    Mapping(0, 1) = "df"
    Mapping(1, 0) = 1
    Mapping(1, 1) = "ssdf"
    QuickSort2 Mapping(), 2, 0
    Stop
End Sub

Open in new window

0
 

Author Comment

by:rrhandle8
ID: 39784203
WTF!  OK, it works.  I don't quite understand yet, but I have never enjoyed award 500 points more :-)
0

Featured Post

Salesforce Made Easy to Use

On-screen guidance at the moment of need enables you & your employees to focus on the core, you can now boost your adoption rates swiftly and simply with one easy tool.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

It’s been over a month into 2017, and there is already a sophisticated Gmail phishing email making it rounds. New techniques and tactics, have given hackers a way to authentically impersonate your contacts.How it Works The attack works by targeti…
This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

821 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question