[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 455
  • Last Modified:

VBA sort routine not always working

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
rrhandle8
Asked:
rrhandle8
1 Solution
 
NorieCommented:
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
 
rrhandle8Author Commented:
WTF!  OK, it works.  I don't quite understand yet, but I have never enjoyed award 500 points more :-)
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now