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...