Re: VBA Sort 2-dimensional array based on 2 column

Does the example code at the beginning work for you?
You could check by adding a few lines that output a sample to the
debug/immediate window:
(after the MsgBox line)
For i = UBound(S1, 2) / 2 To UBound(S1, 2) / 2 + 20
Debug.Print S1(0, i), S1(1, i), S1(2, i), S1(3, i) ' , ...
Next i

Empty keys should be sorted to the start, I guess. But since you probably
don't have empty keys in your second sort (last name), that shouldn't matter
much?

For a list box, a simple (stable) bubble sort should work fine. I've used
the MergeSort a few times because it's much much faster if you have lots of
records to sort (say order 100.000 or more).

Good luck!
Klaus



"Irene" <ienulf@xxxxxxxxxxx> wrote:
Thank you for all of your help.

It is probably something I am doing wrong.
I have a list box on a form filled with various data about contacts which
I
have pulled from Outlook. I have a button that sorts the list box first by
age then by last name. I pull all of the data into an array (variant) then
I
use the sort (pMergeSort myArray, 5). It does something, but the columns
are
reorder and I can see what column has been sorted if any. I don't get any
error.

Some of the fields are blank, can that mess up the sort?

I understand that it is hard to help this way, but let me know if you need
more info


"Klaus Linke" wrote:

The column number to sort by is the second argument, ColNr, in the code I
posted.
If your array is named myArray, and you want to sort by column 5 (say age
in
your case), then by column 0 (say last name):
pMergeSort myArray, 5
pMergeSort myArray, 0

Regards,
Klaus


"Irene" <ienulf@xxxxxxxxxxx> schrieb im Newsbeitrag
news:CE86BC05-B767-4A25-866E-FC28CB6A672E@xxxxxxxxxxxxxxxx


Thank you,

I think I have it running. My array has 10 columns (0-9). I am not sure
where in the code I should specify this. The sort runs but gives me the
wrong
results and reorders some of the columns. I guess this has to do with
the
column count. I will run the sort as sort by age first then sort by
last
name.

Irene


"Klaus Linke" wrote:

"Irene" <ienulf@xxxxxxxxxxx> wrote:
I have an array filled with names which i pull from Outlook. The
array
has
7
columns. How to i sort based on 2 columns, First sort on last name
and
then
by age?

I have seen many sort alg. but none with 2 column sort
Thanks,



Hi Irene,

You need some sorting algorithm that's "stable". This means if two
records
have the same key, they appear in the same order in the sorted list as
they
appear in the original list.
So you can sort first by age, then by last name. If the sort is
stable,
the
entries with the same last name will still be sorted by age.

I use Mergesort, adapted from this site:
http://www.devx.com/vb2themax/Tip/19470

Option Explicit

' (c) http://www.devx.com/vb2themax/Tip/19470
' MergeSort. A stable sort (preserves original order of records with
equal
' keys). Like HeapSort, easily adapted to any data type and
guaranteed
to
run
' in O(N log N) time, but almost twice as fast. On the down side,
' needs an extra array of N items, but these can be pointers if the
keys
' themselves are larger than pointers. Works by repeatedly merging
short
' sorted sequences (created by InsertionSort) into longer ones. Two
versions
' are given. pMergeSortS is an indirect (pointerized) version for
strings,
' which can be adapted to doubles by changing the declaration of A().
' MergeSortL is a direct version for longs, which can be adapted to
integers.
'
'
' Bottom line: fast stable sort that easily handles all data types,
' but a heavy memory user.

' Usage:
Public l
Public R
Public ColTot
Sub TestMerge()
Dim i As Long, j As Long
Dim start
l = 0
R = 100000
ColTot = 12
Dim ColNr As Long
ColNr = 1
Dim S1() As Variant
ReDim S1(0 To ColTot, l To R)

For i = l To R
S1(0, i) = i
S1(1, i) = Int(1000 * Rnd())
S1(2, i) = ChrW(AscW("a") + Int(12 * Rnd())) & ChrW(AscW("a") +
Int(12 *
Rnd()))
For j = 3 To ColTot
S1(j, i) = GetRandomLong()
Next j
Next i


start = Timer
pMergeSort S1, 3
MsgBox Timer - start
End Sub

' CODE:
Sub pMergeSort(a() As Variant, ColNr As Long)
Dim LBA1 As Long
LBA1 = LBound(a, 1)
Dim UBA1 As Long
UBA1 = UBound(a, 1)
Dim LBA2 As Long
LBA2 = LBound(a, 2)
Dim UBA2 As Long
UBA2 = UBound(a, 2)
Dim i As Long, j As Long
Dim P1() As Long
Dim P2() As Long
Dim B() As Variant
ReDim P1(LBA2 To UBA2)
ReDim P2(LBA2 To UBA2)
For i = LBound(a, 2) To UBound(a, 2)
P1(i) = i
Next i

pMergeSortS LBound(a, 2), UBound(a, 2), a, P1, P2, ColNr
B = a
For i = LBA1 To UBA1
For j = LBA2 To UBA2
a(i, j) = B(i, P1(j))
Next j
Next i
End Sub

Sub pMergeSortS(l As Long, R As Long, a() As Variant, P() As Long, Q()
As
Long, ColNr As Long)

Dim LP As Long 'left pointer
Dim RP As Long 'right pointer
Dim OP As Long 'output pointer
Dim MID As Long

'This version is for variants; for other data types,
' change declaration of A().
'MergeSort recursively calls itself until we have lists short
enough
for
' InsertionSort.
If R - l < 10 Then
'call an indirect (pointerized) version of InsertionSort
pInsertS l, R, a, P, ColNr
Else
'if too long for InsertionSort, split list and recurse
MID = (l + R) \ 2
pMergeSortS l, MID, a, P, Q, ColNr
pMergeSortS MID + 1, R, a, P, Q, ColNr

'Each half of the array is sorted; now we'll merge them into
the
extra
' array.
'We'll work via pointers, to keep the extra array smaller.
LP = l
RP = MID + 1
OP = l
Do
'Copy the pointer to the smaller string.
If a(ColNr, P(LP)) <= a(ColNr, P(RP)) Then
Q(OP) = P(LP)
OP = OP + 1
LP = LP + 1
If LP > MID Then
'We ran out of the left half, so transfer the rest of the
right
' half.
Do
Q(OP) = P(RP)
OP = OP + 1
RP = RP + 1
Loop Until RP > R
'This merge is done.
Exit Do
End If
Else
'This part is a mirror image of the last part.
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 > MID
Exit Do
End If
End If
Loop
'Finally, we copy the pointers back from the extra array to the
main
array.
For OP = l To R
P(OP) = Q(OP)
Next OP
End If
End Sub

Sub pInsertS(l As Long, R As Long, a() As Variant, P() As Long, ColNr
As
Long)
Dim LP As Long
Dim RP As Long
Dim TMP As Long
Dim t As Variant

For RP = l + 1 To R
TMP = P(RP)
t = a(ColNr, TMP)
For LP = RP To l + 1 Step -1
If t < a(ColNr, P(LP - 1)) Then P(LP) = P(LP - 1) Else
Exit
For
Next LP
P(LP) = TMP
Next RP
End Sub











.

Loading