Hi All,
I have a requirement to be able to stable sort a 2D array (which contains either alphanumeric or date values) in a legacy VB6 application we are required to support. Below is the array sorting code we currently are working with (unsure of original author, was located in a post on here by Ellis Dee):
When using an alphanumeric array, the sort works correctly but fails on a date array. Below is the output of the date array post-sort:
Any ideas on how I can modify this code to sort dates correctly as well? Or pointers to a better-suited sort for my purposes? We would like to keep the sorting functionality to a single sub if at all possible.
Any assistance in this regard is greatly appreciated!
Best Regards
Brad
I have a requirement to be able to stable sort a 2D array (which contains either alphanumeric or date values) in a legacy VB6 application we are required to support. Below is the array sorting code we currently are working with (unsure of original author, was located in a post on here by Ellis Dee):
Code:
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
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
End SubCode:
11/1/2013 1-Nov-2013
11/10/2013 10-Nov-2013
11/11/2013 11-Nov-2013
11/12/2013 12-Nov-2013
11/2/2013 2-Nov-2013
10/2/2013 2-Oct-2013
10/24/2013 24-Oct-2013
10/29/2013 29-Oct-2013
10/30/2013 30-Oct-2013
10/31/2013 31-Oct-2013
11/4/2013 4-Nov-2013
11/5/2013 5-Nov-2013
11/6/2013 6-Nov-2013
11/7/2013 7-Nov-2013
11/8/2013 8-Nov-2013
11/9/2013 9-Nov-2013Any assistance in this regard is greatly appreciated!
Best Regards
Brad