or How I stopped worrying and hacked someone else's code.

One of the most frustrating non-options with VB Scripting is the inability to sort arrays. If you've rolled your own, most people opt for the bubble sort method. This works great until you have a medium to large array. Then it becomes horribly inefficient.

On the 4 Guys From Rolla web site, they have a nifty ASP function published called Quick Sort that can handle multi-dimensional sorting. It's based on the algorithm given in Data Abstractions & Structures using C++ by Mark Headington and David Riley, (pg. 586).

The 4 Guys From Rolla QuickSort is very nice, but has a few short comings. One: It does not offer an option for Ascending/Descending Sorting. Two: It does string compares for all field comparisons. Three: You must have the array structured as Row,Column which is backwards from how ADO returns an array via the getRows function. [rant]MvHO it's ADO that returns the array backwards. Why couldn't MS offer both ways if there was a need to "maintain backwards compatibility" with a historically fubarred thought process??[/rant]

Anywho - I hacked the 4 Guys From Rolla Quick Sort routine (it's nice to be able to stand on the shoulders of giants) to support sorting direction as well as embedded a function that checks to see if the two fields being compared can both be evaluated as Numeric or as Strings (default) and "cloned" the QuickSort routine for the ADO way of array thinking.

The only thing lacking now with QuickSortv2 and QuickSortv2_ADO is a second column sort - but I'll leave that to someone better qualified to implement. ;-)

To utilize the Quick Sort routines, call it this way:

QuickSortADO vecloBoundhiBoundSortFieldSortDir

QuickSort vecloBoundhiBoundSortFieldSortDir

Parameters:

Note: The PrintArray and PrintArrayADO are quick and dirty functions to print out your array in a table structure to quickly evaluate the sorting routine. So at minimum you need three functions: QuickSortADO, SwapRowsADO, and FormatCompare and/or QuickSort, SwapRows, and FormatCompare. Obviously you only need one copy of FormatCompare if you want both QuickSort routines in your library.

***Quick Sort v2***

''' Regular Array Sort

Sub QuickSort(vec,loBound,hiBound,SortField,SortDir)

'==--------------------------------------------------------==

'== Sort a multi dimensional array on SortField ==

'== ==

'== This procedure is adapted from the algorithm given in: ==

'== ~ Data Abstractions & Structures using C++ by ~ ==

'== ~ Mark Headington and David Riley, pg. 586 ~ ==

'== Quicksort is the fastest array sorting routine for ==

'== unordered arrays. Its big O is n log n ==

'== ==

'== Parameters: ==

'== vec - array to be sorted ==

'== SortField - The field to sort on (1st dimension value) ==

'== loBound and hiBound are simply the upper and lower ==

'== bounds of the array's "row" dimension. It's probably ==

'== easiest to use the LBound and UBound functions to ==

'== set these. ==

'== SortDir - ASC, ascending; DESC, Descending ==

'==--------------------------------------------------------==

if not (hiBound - loBound = 0) then

Dim pivot(),loSwap,hiSwap,temp,counter

Redim pivot (Ubound(vec,2))

SortDir = UCase(SortDir)

'== Two items to sort

if hiBound - loBound = 1 then

if (SortDir = "ASC") then

if FormatCompare(vec(loBound,SortField),vec(hiBound,SortField)) > FormatCompare(vec(hiBound,SortField),vec(loBound,SortField)) then Call SwapRows(vec,hiBound,loBound)

else

if FormatCompare(vec(loBound,SortField),vec(hiBound,SortField)) < FormatCompare(vec(hiBound,SortField),vec(loBound,SortField)) then Call SwapRows(vec,hiBound,loBound)

end if

End If

'== Three or more items to sort

For counter = 0 to Ubound(vec,2)

pivot(counter) = vec(int((loBound + hiBound) / 2),counter)

vec(int((loBound + hiBound) / 2),counter) = vec(loBound,counter)

vec(loBound,counter) = pivot(counter)

Next

loSwap = loBound + 1

hiSwap = hiBound

do

'== Find the right loSwap

if (SortDir = "ASC") then

while loSwap < hiSwap and FormatCompare(vec(loSwap,SortField),pivot(SortField)) <= FormatCompare(pivot(SortField),vec(loSwap,SortField))

loSwap = loSwap + 1

wend

else

while loSwap < hiSwap and FormatCompare(vec(loSwap,SortField),pivot(SortField)) >= FormatCompare(pivot(SortField),vec(loSwap,SortField))

loSwap = loSwap + 1

wend

end if

'== Find the right hiSwap

if (SortDir = "ASC") then

while FormatCompare(vec(hiSwap,SortField),pivot(SortField)) > FormatCompare(pivot(SortField),vec(hiSwap,SortField))

hiSwap = hiSwap - 1

wend

else

while FormatCompare(vec(hiSwap,SortField),pivot(SortField)) < FormatCompare(pivot(SortField),vec(hiSwap,SortField))

hiSwap = hiSwap - 1

wend

end if

'== Swap values if loSwap is less then hiSwap

if loSwap < hiSwap then Call SwapRows(vec,loSwap,hiSwap)

loop while loSwap < hiSwap

For counter = 0 to Ubound(vec,2)

vec(loBound,counter) = vec(hiSwap,counter)

vec(hiSwap,counter) = pivot(counter)

Next

'== Recursively call function .. the beauty of Quicksort

'== 2 or more items in first section

if loBound < (hiSwap - 1) then Call QuickSort(vec,loBound,hiSwap-1,SortField,SortDir)

'== 2 or more items in second section

if hiSwap + 1 < hibound then Call QuickSort(vec,hiSwap+1,hiBound,SortField,SortDir)

end if

End Sub 'QuickSort

Sub SwapRows(ary,row1,row2)

'==------------------------------------------==

'== This proc swaps two rows of an array ==

'==------------------------------------------==

Dim x,tempvar

For x = 0 to Ubound(ary,2)

tempvar = ary(row1,x)

ary(row1,x) = ary(row2,x)

ary(row2,x) = tempvar

Next

End Sub 'SwapRows

function FormatCompare(sOne,sTwo)

'==------------------------------------------==

'== Checks sOne & sTwo, returns sOne as a ==

'== Numeric if both pass isNumeric, if not ==

'== returns sOne as a string. ==

'==------------------------------------------==

if (isNumeric(Trim(sOne)) AND isNumeric(Trim(sTwo))) then

FormatCompare = CDbl(Trim(sOne))

else

FormatCompare = Trim(sOne)

end if

end function

Sub PrintArray(vec,loRow,hiRow,markCol)

'==------------------------------------------==

'== Print out an array Highlight the column ==

'== whose number matches param markCol ==

'==------------------------------------------==

Dim ColNmbr,RowNmbr

Response.Write "<table border=""1"" cellspacing=""0"">"

For RowNmbr = loRow to hiRow

Response.Write "<tr>"

For ColNmbr = 0 to (Ubound(vec,2) - 1)

If ColNmbr = markCol then

Response.Write "<td bgcolor=""FFFFCC"">"

Else

Response.Write "<td>"

End If

Response.Write vec(RowNmbr,ColNmbr) & "</td>"

Next

Response.Write "</tr>"

Next

Response.Write "</table>"

End Sub 'PrintArray

***Quick Sort v2 ADO***

''' ADO Array Sort

Sub QuickSortADO(vec,loBound,hiBound,SortField,SortDir)

'==--------------------------------------------------------==

'== Sort a multi dimensional array on SortField ==

'== ==

'== This procedure is adapted from the algorithm given in: ==

'== ~ Data Abstractions & Structures using C++ by ~ ==

'== ~ Mark Headington and David Riley, pg. 586 ~ ==

'== Quicksort is the fastest array sorting routine for ==

'== unordered arrays. Its big O is n log n ==

'== ==

'== Parameters: ==

'== vec - array to be sorted ==

'== SortField - The field to sort on (1st dimension value) ==

'== loBound and hiBound are simply the upper and lower ==

'== bounds of the array's "row" dimension. It's probably ==

'== easiest to use the LBound and UBound functions to ==

'== set these. ==

'== SortDir - ASC, ascending; DESC, Descending ==

'==--------------------------------------------------------==

if not (hiBound - loBound = 0) then

Dim pivot(),loSwap,hiSwap,temp,counter

Redim pivot (Ubound(vec,1))

SortDir = UCase(SortDir)

'== Two items to sort

if hiBound - loBound = 1 then

if (SortDir = "ASC") then

if FormatCompare(vec(SortField,loBound),vec(SortField,hiBound)) > FormatCompare(vec(SortField,hiBound),vec(SortField,loBound)) then Call SwapRowsADO(vec,hiBound,loBound)

else

if FormatCompare(vec(SortField,loBound),vec(SortField,hiBound)) < FormatCompare(vec(SortField,hiBound),vec(SortField,loBound)) then Call SwapRowsADO(vec,hiBound,loBound)

end if

End If

'== Three or more items to sort

For counter = 0 to Ubound(vec,1)

pivot(counter) = vec(counter,int((loBound + hiBound) / 2))

vec(counter,int((loBound + hiBound) / 2)) = vec(counter,loBound)

vec(counter,loBound) = pivot(counter)

Next

loSwap = loBound + 1

hiSwap = hiBound

do

'== Find the right loSwap

if (SortDir = "ASC") then

while loSwap < hiSwap and FormatCompare(vec(SortField,loSwap),pivot(SortField)) <= FormatCompare(pivot(SortField),vec(SortField,loSwap))

loSwap = loSwap + 1

wend

else

while loSwap < hiSwap and FormatCompare(vec(SortField,loSwap),pivot(SortField)) >= FormatCompare(pivot(SortField),vec(SortField,loSwap))

loSwap = loSwap + 1

wend

end if

'== Find the right hiSwap

if (SortDir = "ASC") then

while FormatCompare(vec(SortField,hiSwap),pivot(SortField)) > FormatCompare(pivot(SortField),vec(SortField,hiSwap))

hiSwap = hiSwap - 1

wend

else

while FormatCompare(vec(SortField,hiSwap),pivot(SortField)) < FormatCompare(pivot(SortField),vec(SortField,hiSwap))

hiSwap = hiSwap - 1

wend

end if

'== Swap values if loSwap is less then hiSwap

if loSwap < hiSwap then Call SwapRowsADO(vec,loSwap,hiSwap)

loop while loSwap < hiSwap

For counter = 0 to Ubound(vec,1)

vec(counter,loBound) = vec(counter,hiSwap)

vec(counter,hiSwap) = pivot(counter)

Next

'== Recursively call function .. the beauty of Quicksort

'== 2 or more items in first section

if loBound < (hiSwap - 1) then Call QuickSortADO(vec,loBound,hiSwap-1,SortField,SortDir)

'== 2 or more items in second section

if hiSwap + 1 < hibound then Call QuickSortADO(vec,hiSwap+1,hiBound,SortField,SortDir)

end if

End Sub 'QuickSortADO

Sub SwapRowsADO(ary,row1,row2)

'==------------------------------------------==

'== This proc swaps two rows of an array ==

'==------------------------------------------==

Dim x,tempvar

For x = 0 to Ubound(ary,1)

tempvar = ary(x,row1)

ary(x,row1) = ary(x,row2)

ary(x,row2) = tempvar

Next

End Sub 'SwapRowsADO

function FormatCompare(sOne,sTwo)

'==------------------------------------------==

'== Checks sOne & sTwo, returns sOne as a ==

'== Numeric if both pass isNumeric, if not ==

'== returns sOne as a string. ==

'==------------------------------------------==

if (isNumeric(Trim(sOne)) AND isNumeric(Trim(sTwo))) then

FormatCompare = CDbl(Trim(sOne))

else

FormatCompare = Trim(sOne)

end if

end function

Sub PrintArrayADO(vec,loRow,hiRow,markCol)

'==------------------------------------------==

'== Print out an array Highlight the column ==

'== whose number matches param markCol ==

'==------------------------------------------==

Dim ColNmbr,RowNmbr

Response.Write "<table border=""1"" cellspacing=""0"">"

For RowNmbr = loRow to hiRow

Response.Write "<tr>"

For ColNmbr = 0 to Ubound(vec,1)

If ColNmbr = markCol then

Response.Write "<td bgcolor=""FFFFCC"">"

Else

Response.Write "<td>"

End If

Response.Write vec(ColNmbr,RowNmbr) & "</td>"

Next

Response.Write "</tr>"

Next

Response.Write "</table>"

End Sub 'PrintArray