Dave

That would be a godsend.

At this point, my immediate need is for the case where the sort fiel
is string! But if you can send me the VBA code for both (that woul
come in handy at some stage I am sure) for both Counting and Merg
Sorts, that would be wonderful!

Greatly appreciated!


Deepak Agarwa

--
agarwaldv
-----------------------------------------------------------------------
agarwaldvk's Profile: http://www.excelforum.com/member.php...fo&userid=1134
View this thread: http://www.excelforum.com/showthread.php?threadid=27231

Here are string versions of merge and radix sort. In each case, A() is
an array containing the strings you want to sort. P() is an array of
longs indexing the strings in A(), and Q() is an empty array of longs
the same size as P(). LO and HI are the first and last strings to sort.

Both sorts move pointers (the indices in P and Q) rather than the
strings themselves. If you have N strings in array A, you would
dimension P and Q from 1 to N and set P(1) = 1 ... P(N) = N. After
running either sort, the indices in P will be rearranged into sorted
order, and you would output the strings in sorted order as A(P(1)) ...
A(P(N)).

If your data is in a range, you will have to do a little set-up work. If
you want to sort on two columns, you would read one column into string
array A1 and the other into string array A2, and you would put the row
numbers into the index array P. Then sort based on A1 (if that's the
field you want to sort by first), and use the sorted index array P to
sort again with string array A2. Finally, use P to actually rearrange
the rows.

On an 800 mhz PowerBook with Excel 2001, these sorts will process 50,000
random strings in 3-4 seconds (sorting alone; reading and rewriting rows
would add to that). Radix is 50-60% faster than merge. Both are
stable. Both use insertion sort to efficiently process sublists shorter
than 25 strings. If your strings are quite short, the index arrays may
not save time and memory over moving the strings themselves, but unless
the strings are fixed length that can get complicated.

Dave

Public Sub pRadixS(A$(), P&(), Q&(), ByVal LO&, ByVal HI&)
Dim CH&(), SP&, LS&(1 To 500), RS&(1 To 500), DS&(1 To 500)
Dim L&, R&, D&, I&, S$, V&, CT&(31 To 255)
Dim oSP&, hCT&, hSP&, TOT&, AD&(31 To 255), CNT&, J&

ReDim CH(LO To HI): SP = 1: LS(SP) = LO: RS(SP) = HI: DS(SP) = 1
While SP 0
L = LS(SP): R = RS(SP): D = DS(SP): SP = SP - 1
For I = L To R
S = Mid$(A(P(I)), D, 1)
If S = "" Then V = 31 Else V = Asc(S)
CT(V) = CT(V) + 1: CH(I) = V
Next I
D = D+1: oSP = SP: hCT = 0: hSP = 0: AD(31) = L: TOT = L+CT(31)
For I = 32 To 255
AD(I) = TOT: CNT = CT(I): TOT = TOT + CNT
If CNT 24 Then
SP = SP + 1: LS(SP) = AD(I): RS(SP) = TOT-1: DS(SP) = D
If CNT hCT Then
hCT = CNT: hSP = SP
End If
End If
If TOT = HI Then Exit For
Next I
Erase CT: J = hSP: hSP = oSP: oSP = J
For I = L To R
V = CH(I): J = AD(V): AD(V) = J + 1: Q(J) = P(I)
Next I
For I = L To R: P(I) = Q(I): Next I
Wend
For R = LO + 1 To HI
I = P(R): S = A(I)
For L = R To LO + 1 Step -1
J = P(L - 1)
If S < A(J) Then P(L) = J Else Exit For
Next L
P(L) = I
Next R
End Sub

Sub pMergeS(A$(), P&(), Q&(), LO&, HI&)
Dim rLN#, nR&, D#, I&, L&, R&, LP&, RP&, V$, OP&, TP&

nR = 1: rLN = 1 + HI - LO: D = LO
While rLN 24: rLN = rLN / 4: nR = nR * 4: Wend
For I = 0 To nR - 1
L = D: D = D + rLN: R = CLng(D) - 1
For RP = L + 1 To R
OP = P(RP): V = A(OP)
For LP = RP To L + 1 Step -1
TP = P(LP - 1)
If V < A(TP) Then P(LP) = TP Else Exit For
Next LP
P(LP) = OP
Next RP
Next I
While nR 1
D = LO
For I = 2 To nR Step 2
LP = D: OP = LP: D = D + rLN: RP = D: L = RP - 1
D = D + rLN: R = CLng(D) - 1
Do
If A(P(LP)) <= A(P(RP)) Then
Q(OP) = P(LP): OP = OP + 1: LP = LP + 1
If LP L Then
Do: Q(OP) = P(RP): OP = OP + 1: RP = RP + 1
Loop Until RP R: Exit Do
End If
Else
Q(OP) = P(RP): OP = OP + 1: RP = RP + 1
If RP R Then
Do: Q(OP) = P(LP): OP = OP + 1: LP = LP + 1
Loop Until LP L: Exit Do
End If
End If
Loop
Next I
rLN = rLN * 2: nR = nR \ 2: D = LO
For I = 2 To nR Step 2
LP = D: OP = LP: D = D + rLN: RP = D: L = RP - 1
D = D + rLN: R = CLng(D) - 1
Do
If A(Q(LP)) <= A(Q(RP)) Then
P(OP) = Q(LP): OP = OP + 1: LP = LP + 1
If LP L Then
Do: P(OP) = Q(RP): OP = OP + 1: RP = RP + 1
Loop Until RP R: Exit Do
End If
Else
P(OP) = Q(RP): OP = OP + 1: RP = RP + 1
If RP R Then
Do: P(OP) = Q(LP): OP = OP + 1: LP = LP + 1
Loop Until LP L: Exit Do
End If
End If
Loop
Next I
rLN = rLN * 2: nR = nR \ 2
Wend
End Sub

agarwaldvk wrote:
Dave

That would be a godsend.

At this point, my immediate need is for the case where the sort field
is string! But if you can send me the VBA code for both (that would
come in handy at some stage I am sure) for both Counting and Merge
Sorts, that would be wonderful!

Greatly appreciated!


Deepak Agarwal