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

d.i.barr

New Member
Joined
Jan 24, 2005
Messages
2
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...
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Forum statistics

Threads
1,147,510
Messages
5,741,574
Members
423,668
Latest member
Audorin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top