Quicksort of Rows in Excel by one Column (VBA Query)

[d.i.barr]

Hi there,
I have some code that will read a variable length column, input that into an array and then perform a quick-sort on the contents of that array. Now I need this code to be modified so that rather than the contents of this array are written in order, the actual row that the number is loccated on is "sorted".

Here is the code in question:


Option Explicit

Sub VariableLengthSelection()
Dim initArray() As Byte
Dim initRange As Range
Dim i As Integer
i = 1
Dim r As Integer
r = 0

'Determine the length of the initiative column
Do Until Range("D1").Offset(i, 0).Value = ""
i = i + 1
Loop
'Store the range of the initiative column
Set initRange = Range("D1", Range("D1").Offset(i - 1, 0))

'Set the size of the array to equal the number of entries in the initative column
ReDim initArray(i - 1)
'For each element in the array, write the value in the correct cell to the array space
For r = 0 To (i - 1)
initArray(r) = initRange(r + 1, 1)
Next r

'###Now the sorting begins
Quicksort (initArray)

'Write the sorted list of initiatives
For r = 1 To (i)
initRange(r, 2) = initArray(r - 1)
Next r
End Sub

Function Quicksort(ByRef vntArr As Variant, Optional ByVal lngLeft As Long = -2, Optional ByVal lngRight As Long = -2) As Variant

Dim i, j, lngMid As Long
Dim vntTestVal As Variant

If lngLeft = -2 Then lngLeft = LBound(vntArr)
If lngRight = -2 Then lngRight = UBound(vntArr)

If lngLeft < lngRight Then
lngMid = (lngLeft + lngRight) \ 2
vntTestVal = vntArr(lngMid)
i = lngLeft
j = lngRight
Do
Do While vntArr(i) < vntTestVal
i = i + 1
Loop
Do While vntArr(j) > vntTestVal
j = j - 1
Loop
If i <= j Then
Call SwapElements(vntArr, i, j)
i = i + 1
j = j - 1
End If
Loop Until i > j

' Optimize sort by sorting smaller segment first
If j <= lngMid Then
vntArr = Quicksort(vntArr, lngLeft, j)
vntArr = Quicksort(vntArr, i, lngRight)
Else
vntArr = Quicksort(vntArr, i, lngRight)
vntArr = Quicksort(vntArr, lngLeft, j)
End If
End If

Quicksort = vntArr
End Function

' Used in QuickSort function
Private Sub SwapElements(ByRef vntItems As Variant, ByVal lngItem1 As Long, ByVal lngItem2 As Long)

Dim vntTemp As Variant

vntTemp = vntItems(lngItem2)
vntItems(lngItem2) = vntItems(lngItem1)
vntItems(lngItem1) = vntTemp
End Sub



I am running windows 2000 Pro and using excel 2000. Any help would be appreciated.

Dave...

 

[d.i.barr]

Any ideas if this is even possible?