In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend

'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2, iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Truncated

I don't think you can create COM add-ins with Office Developer. I think you
need VB6 or later.A compiled add-in would be much faster than what you can
do with VBA.

/Fredrik

I don't think you can create COM add-ins with Office Developer.

Yes, you can. In the VBA Editor, choose New Project from the File
menu.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com



"Fredrik Wahlgren" wrote
in message ...

"RB Smissaert" wrote in
message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but
thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with
the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this
dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often
too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Truncated

I don't think you can create COM add-ins with Office Developer.
I think you
need VB6 or later.A compiled add-in would be much faster than
what you can
do with VBA.

/Fredrik

Well, you definitely can do that as I have just done it!
The test workbook is also definitely using the the dll as
there is no code whatsoever in the workbook to sort the array.
If you want to see it for your self I can send you the dll and the test
..xls file.

RBS


"Fredrik Wahlgren" wrote in message
...

"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Truncated

I don't think you can create COM add-ins with Office Developer. I think
you
need VB6 or later.A compiled add-in would be much faster than what you can
do with VBA.

/Fredrik

Hi,

Use Laurent Longre's VSORT (or VSORT.IDX) function available in his MOREFUNC.XLL
It's built in 'C' (using pointers for swapping elements) so it's quite fast.

Once installed, it can be invoked in VBA as in:
Dim V As Variant
V = Application.Run([VSORT], Range("A1:B20"), 1)

Regards,

Daniel M.

"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend

'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2, iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

You could try loading your data into an ADO recordset and sorting it
there.
Google for "disconnected recordset" and ADO

Tim



"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is
about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too
big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point
item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point
item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend
'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1,
iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2,
iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

Hi RB,

Below the routine I downloaded. Not sure who wrote it:

I believe that the Sub procSort2D routine would have been downloaded as part
of Stephen Bullen's QuickSort demo.


You have reponses to the substantive question, but I shall watch the thread
with interest.


---
Regards,
Norman



"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend
'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2, iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

Thanks, will have a look at that.
Your example mentions a range.
Is this a range in the sheet?
My arrays are VBA arrays, would it
work with that?

RBS

"Daniel.M" wrote in message
...
Hi,

Use Laurent Longre's VSORT (or VSORT.IDX) function available in his
MOREFUNC.XLL
It's built in 'C' (using pointers for swapping elements) so it's quite
fast.

Once installed, it can be invoked in VBA as in:
Dim V As Variant
V = Application.Run([VSORT], Range("A1:B20"), 1)

Regards,

Daniel M.

"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend

'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1,
iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2,
iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

Thanks, but I have tried that already and it turned out to be about twice as
slow.
I use it though, because you can sort on more than one field.
Below the code for this:

Sub SQLArraySort(ByRef arrData As Variant, _
ByVal lSortField1 As Long, _
ByVal strSortType1 As String, _
ByVal bHasFields As Boolean, _
ByVal bArrayInput As Boolean, _
ByVal bArrayOutput As Boolean, _
Optional ByVal lCols As Long = 0, _
Optional ByVal strInputFile As String = "", _
Optional ByVal strOutputFile As String = "", _
Optional ByVal lSortField2 As Long = 0, _
Optional ByVal strSortType2 As String = "")

Dim LB1 As Long
Dim UB1 As Long
Dim LB2 As Long
Dim UB2 As Long
Dim c As Long
Dim strFields As String
Dim arrFields
Dim strQuery As String
Dim strOrderString As String
Dim rs As ADODB.Recordset
Dim strTempFile As String
Dim strSortedFile As String
Dim strSchemaFile As String

On Error GoTo ERROROUT

If strInputFile = "" Then
strTempFile = TempTablesFolder & "tmpFile.txt"
strInputFile = "tmpFile.txt"
Else
strTempFile = TempTablesFolder & strInputFile
End If

If strOutputFile = "" Then
strSortedFile = TempTablesFolder & "SortedFile.txt"
strOutputFile = "SortedFile.txt"
Else
strSortedFile = TempTablesFolder & strOutputFile
End If

strSchemaFile = TempTablesFolder & "Schema.ini"

If bArrayInput = True Then
If bFileExists(strTempFile) Then
Kill strTempFile
End If
End If

If bFileExists(strSortedFile) Then
Kill strSortedFile
End If

If bFileExists(strSchemaFile) Then
Kill strSchemaFile
End If

If bArrayInput = False Then
If bHasFields = False Then
'working directly with a text file that has no fields yet
'--------------------------------------------------------
strFields = "Field" & c
If lCols 1 Then
For c = 2 To lCols
strFields = strFields & ", Field" & c
Next
End If
InsertLineAtBeginningTexFile strTempFile, strFields
Else
'working directly with a text file that has fields already
'---------------------------------------------------------
strFields = GetFieldsFromText(strTempFile, lCols)
End If
End If 'If bArrayInput = False

If bArrayInput = True Then

LB1 = LBound(arrData)
UB1 = UBound(arrData)
LB2 = LBound(arrData, 2)
UB2 = UBound(arrData, 2)

ReDim arrFields(LB2 To UB2) As String

'make the fields string and fields array
'---------------------------------------
If bHasFields = False Then
strFields = "Field" & 1 - LB2
arrFields(LB2) = "Field" & 1 - LB2
If UB1 LB1 Then
For c = LB2 + 1 To UB2
strFields = strFields & ", " & "Field" & c + (1 - LB2)
arrFields(c) = "Field" & c + (1 - LB2)
Next
End If
Else
strFields = arrData(LB1, LB2)
arrFields(LB2) = arrData(LB1, LB2)
If UB1 LB1 Then
For c = LB2 + 1 To UB2
strFields = strFields & ", " & arrData(LB1, LB2 + c)
arrFields(c) = arrData(LB1, LB2 + c)
Next
End If
End If 'If bHasFields = False

'write the array to text
'-----------------------
If bHasFields = False Then
SaveArrayToText2 strTempFile, _
arrData, _
LB1, _
UB1, _
LB2, _
UB2, _
arrFields
Else
SaveArrayToText2 strTempFile, _
arrData, _
LB1, _
UB1, _
LB2, _
UB2
End If
End If 'If bArrayInput = True

'make the SQL ORDER clause
'-------------------------
If lSortField2 = 0 Then
If strSortType1 = "A" Then
strOrderString = "ORDER BY " & _
lSortField1 & " ASC"
Else
strOrderString = "ORDER BY " & _
lSortField1 & " DESC"
End If
Else
If strSortType1 = "A" Then
If strSortType2 = "A" Then
strOrderString = "ORDER BY " & _
lSortField1 & " ASC, " & _
lSortField2 & " ASC"
Else
strOrderString = "ORDER BY " & _
lSortField1 & " ASC, " & _
lSortField2 & " DESC"
End If
Else
If strSortType2 = "A" Then
strOrderString = "ORDER BY " & _
lSortField1 & " DESC, " & _
lSortField2 & " ASC"
Else
strOrderString = "ORDER BY " & _
lSortField1 & " DESC, " & _
lSortField2 & " DESC"
End If
End If
End If 'If lSortField2 = 0

'run the SQL to sort the text file
'---------------------------------
strQuery = "SELECT " & _
strFields & _
" INTO " & strOutputFile & _
" IN '" & TempTablesFolder & "' " & _
"'Text;FMT=Delimited' " & _
"FROM " & _
strInputFile & " " & _
strOrderString

ShowStatement strQuery

Set rs = New ADODB.Recordset

rs.Open Source:=strQuery, _
ActiveConnection:=TempTextConn, _
CursorType:=adOpenForwardOnly, _
LockType:=adLockReadOnly, _
Options:=adCmdText

Set rs = Nothing

If bArrayOutput = True Then
'write the textfile back to the array
'------------------------------------
If bHasFields = True Then
OpenTextFileToArray strSortedFile, _
arrData, _
LB1, _
UB1, _
LB2, _
UB2
Else
OpenTextFileToArray strSortedFile, _
arrData, _
LB1, _
UB1, _
LB2, _
UB2, _
True
End If
End If 'If bArrayOutput = Tru

Exit Sub
ERROROUT:

MsgBox "THE SUB SQLSortArray COULDN'T COMPLETE" & _
vbCrLf & _
"DUE TO AN ERROR" & _
vbCrLf & vbCrLf & _
"ERROR NUMBER: " & Err.Number & _
vbCrLf & vbCrLf & _
Err.Description, , "SQLSortArray"

Err.Clear

End Sub


RBS

"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
You could try loading your data into an ADO recordset and sorting it
there.
Google for "disconnected recordset" and ADO

Tim



"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend
'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2, iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

OK, if Stephen Bullen wrote it I will make a mention of that in my code.

RBS


"Norman Jones" wrote in message
...
Hi RB,

Below the routine I downloaded. Not sure who wrote it:

I believe that the Sub procSort2D routine would have been downloaded as
part of Stephen Bullen's QuickSort demo.


You have reponses to the substantive question, but I shall watch the
thread with interest.


---
Regards,
Norman



"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend
'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2, iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

Daniel,

Tried it with VSort of MoreFunc and it is faster indeed!
A simple test shows me it is about 4 to 5 times faster than the Sub
procSort2D.
So thanks for the tip. I will now have to check if the array gets sorted OK,
but I
imagine that this will be fine. Another bonus of VSort is that you can sort
on multiple
columns, so altogether it seems that this is the best solution for sorting
2-D arrays.
Below my testing code:

Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private lStartTime As Long
Private lEndTime As Long

Sub test()

Dim arr(1 To 10000, 1 To 5) As Long
Dim arr2
Dim i As Long
Dim c As Long
Dim bDoMoreFunc As Boolean
Dim strMsg As String

If MsgBox("Use MoreFunc?", _
vbYesNo + vbDefaultButton1, _
"sort 2-D array") = vbYes Then
bDoMoreFunc = True
End If

For i = 1 To 10000
arr(i, 1) = Int((i * Rnd) + 1)
For c = 2 To 5
arr(i, c) = i
Next
Next

lStartTime = timeGetTime()

If bDoMoreFunc = True Then
arr2 = Application.Run([VSORT], arr, arr, 0)
strMsg = "with MoreFunc"
Else
sort2DArray arr, "D", 1
strMsg = "sort2DArray"
End If

lEndTime = timeGetTime()

If bDoMoreFunc = True Then
MsgBox "Descending sort done in " & lEndTime - lStartTime & "
msecs", , _
strMsg & ", arr2(1, 1) now " & arr2(1, 1)
Else
MsgBox "Descending sort done in " & lEndTime - lStartTime & "
msecs", , _
strMsg & ", arr(1, 1) now " & arr(1, 1)
End If

End Sub

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend

'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1, iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2, iHigh1

Exit Sub
ERROROUT:

End Sub



RBS



"Daniel.M" wrote in message
...
Hi,

Use Laurent Longre's VSORT (or VSORT.IDX) function available in his
MOREFUNC.XLL
It's built in 'C' (using pointers for swapping elements) so it's quite
fast.

Once installed, it can be invoked in VBA as in:
Dim V As Variant
V = Application.Run([VSORT], Range("A1:B20"), 1)

Regards,

Daniel M.

"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend

'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1,
iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2,
iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

There is just one thing that is not clear to me.
The help file mainly talks about sorting ranges and it makes it clear how
to choose the sort column, but how does this work with arrays?
Say I have a 10 column array and want to sort ascending on column 2
and descending on column 5, how would that work?

RBS


"Daniel.M" wrote in message
...
Hi,

Use Laurent Longre's VSORT (or VSORT.IDX) function available in his
MOREFUNC.XLL
It's built in 'C' (using pointers for swapping elements) so it's quite
fast.

Once installed, it can be invoked in VBA as in:
Dim V As Variant
V = Application.Run([VSORT], Range("A1:B20"), 1)

Regards,

Daniel M.

"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend

'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1,
iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2,
iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

I think I worked this all out now.
Although it will need making an extra (the array holding the values to sort
on)
it is still 4 to 5 times faster than a QuickSort.
I have made a simple wrapper function that makes sorting arrays with this a
bit easier.
I only needed it to sort up to 3 fields, but you could alter it to go up to
14 fields.


Function VSORTArray(ByRef arr As Variant, _
ByVal btCol1 As Byte, _
ByVal strSortType1 As String, _
Optional ByVal btCol2 As Byte = 0, _
Optional ByVal strSortType2 As String = "", _
Optional ByVal btCol3 As Byte = 0, _
Optional ByVal strSortType3 As String = "") As Variant

'------------------------------------------------------------------
'http://longre.free.fr/english/
'Uses Laurent Longre's VSort function in the .xll add-in MoreFunc
'Will be about 4 to 5 times faster than a quicksort and can sort
'on multiple columns.
'Done up to 3 columns here, but can be done up to 14 columns
'------------------------------------------------------------------
'will sort an 0-based or 1-based 2-D array with up to 3 sort keys
'the field key has to be supplied as a byte, where the first column
'of the array is 1, even if it is an 0-based array
'the sort type has to be given as "a", "A" , "b" or "B"
'examples:
'sorting on 1 field: arr2 = VSORTArray(arr, 1, "A")
'sorting on 2 fields: arr2 = VSORTArray(arr, 2, "D", 5, "A")
'------------------------------------------------------------------

Dim i As Long
Dim LB1 As Long
Dim UB1 As Long
Dim arrKey1
Dim arrKey2
Dim arrKey3
Dim btSortType1 As Byte
Dim btSortType2 As Byte
Dim btSortType3 As Byte
Dim arrFinal

LB1 = LBound(arr)
UB1 = UBound(arr)

'make the array for key 1
'------------------------
ReDim arrKey1(LB1 To UB1, LB1 To LB1)
For i = LB1 To UB1
arrKey1(i, LB1) = arr(i, btCol1 - (1 - LB1))
Next

'set the sort type for key 1
'---------------------------
If UCase(strSortType1) = "A" Then
btSortType1 = 1
Else
btSortType1 = 0
End If

If Not btCol2 = 0 Then
'make the array for key 2
'------------------------
ReDim arrKey2(LB1 To UB1, LB1 To LB1)

For i = LB1 To UB1
arrKey2(i, LB1) = arr(i, btCol2 - (1 - LB1))
Next

'set the sort type for key 2
'---------------------------
If UCase(strSortType2) = "A" Then
btSortType2 = 1
Else
btSortType2 = 0
End If
End If

If Not btCol3 = 0 Then
'make the array for key 3
'------------------------
ReDim arrKey3(LB1 To UB1, LB1 To LB1)
For i = LB1 To UB1
arrKey3(i, LB1) = arr(i, btCol3 - (1 - LB1))
Next

'set the sort type for key 3
'---------------------------
If UCase(strSortType3) = "A" Then
btSortType3 = 1
Else
btSortType3 = 0
End If
End If

If Not strSortType3 = "" Then
'3 fields to sort on
'-------------------
arrFinal = Application.Run([VSORT], arr, _
arrKey1, btSortType1, _
arrKey2, btSortType2, _
arrKey3, btSortType3)
Else
'2 fields to sort on
'-------------------
If Not strSortType2 = "" Then
arrFinal = Application.Run([VSORT], arr, _
arrKey1, btSortType1, _
arrKey2, btSortType2)
Else
'1 field to sort on
'------------------
arrFinal = Application.Run([VSORT], _
arr, arrKey1, btSortType1)
End If
End If

VSORTArray = arrFinal

End Function


RBS


"Daniel.M" wrote in message
...
Hi,

Use Laurent Longre's VSORT (or VSORT.IDX) function available in his
MOREFUNC.XLL
It's built in 'C' (using pointers for swapping elements) so it's quite
fast.

Once installed, it can be invoked in VBA as in:
Dim V As Variant
V = Application.Run([VSORT], Range("A1:B20"), 1)

Regards,

Daniel M.

"RB Smissaert" wrote in message
...
In my application I often have to sort large 2-D arrays.
I have found a routine for this that works quite fast, but thought
maybe it could be made faster by making a dll via a COM add-in
compiled in Office Developer. This was quite easy to do with the
example on Chip Pearson's website.
Unfortunately it turns out that sorting the array with this dll is about
8 to 9 times slower.
Would there be any way to do this faster? The arrays are often too big
for the worksheet, so sorting in the sheet won't work.

Below the routine I downloaded. Not sure who wrote it:

Sub procSort2D(ByRef avArray, _
ByVal sOrder As String, _
ByVal iKey As Long, _
Optional ByVal iLow1 As Long = -1, _
Optional ByVal iHigh1 As Long = -1)

On Error GoTo ERROROUT

Dim iLow2 As Long
Dim iHigh2 As Long
Dim i As Long
Dim vItem1 As Variant
Dim vItem2 As Variant

If iLow1 = -1 Then
iLow1 = LBound(avArray, 1)
End If

If iHigh1 = -1 Then
iHigh1 = UBound(avArray, 1)
End If

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get value of array item in middle of new extremes
vItem1 = avArray((iLow1 + iHigh1) \ 2, iKey)

'Loop for all the items in the array between the extremes
While iLow2 < iHigh2

If sOrder = "A" Then
'Find the first item that is greater than the mid-point item
While avArray(iLow2, iKey) < vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is less than the mid-point item
While avArray(iHigh2, iKey) vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
Else
'Find the first item that is less than the mid-point item
While avArray(iLow2, iKey) vItem1 And iLow2 < iHigh1
iLow2 = iLow2 + 1
Wend

'Find the last item that is greater than the mid-point item
While avArray(iHigh2, iKey) < vItem1 And iHigh2 iLow1
iHigh2 = iHigh2 - 1
Wend
End If

'If the two items are in the wrong order, swap the rows
If iLow2 < iHigh2 Then
For i = LBound(avArray) To UBound(avArray, 2)
vItem2 = avArray(iLow2, i)
avArray(iLow2, i) = avArray(iHigh2, i)
avArray(iHigh2, i) = vItem2
Next
End If

'If the pointers are not together, advance to the next item
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Wend

'Recurse to sort the lower half of the extremes
If iHigh2 iLow1 Then procSort2D avArray, sOrder, iKey, iLow1,
iHigh2

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then procSort2D avArray, sOrder, iKey, iLow2,
iHigh1

Exit Sub
ERROROUT:

MsgBox "There was an error while sorting a 2-D array" & _
vbCrLf & _
"___________________________________" & _
vbCrLf & vbCrLf & _
"most likely there wasn't enough memory" & _
vbCrLf & _
"the size of this array was" & _
vbCrLf & _
"rows: " & vbTab & UBound(avArray) & _
vbCrLf & _
"columns: " & vbTab & UBound(avArray, 2) & _
vbCrLf & vbCrLf & _
"VBA error" & _
vbCrLf & _
"source: " & vbTab & Err.Source & _
vbCrLf & _
"number: " & vbTab & Err.Number & _
vbCrLf & _
"description:" & vbTab & Err.Description, , ""

End Sub


Thanks for any advice.


RBS

RB Smissaert wrote:
You could try loading your data into an ADO recordset and sorting
it
there.
Google for "disconnected recordset" and ADO

Thanks, but I have tried that already and it turned out to be about
twice
as slow.

To be fair, you are not doing as Tim suggested in your code, which has
too many missing dependencies (e.g. sub procedure SaveArrayToText2) to
test <g.

Rather than fabricating a recordset, your code appears to fabricate a
text file. FWIW I don't think your recordset ever gets opened/populated
because the SELECT..INTO..FROM syntax does not return a rowset.

BTW do you have a business requirement to use text files as databases?
Fabricating an .mdb file would yield better performance but I still
have your PATIENT.txt and ENTRY.txt files from way back when to create
an example JOIN between text files.

Jamie.

--

OK, I include the missing dependencies, so you can test.
The reason I use text files is that people that use my software sometimes
have no Access. The other thing is that it surprisingly appears just as
fast.
If you can convince me that Access is faster I might have another look
at using that.


Function OpenTextFileToArray(ByVal txtFile As String, _
ByRef arr As Variant, _
ByVal LBRow As Long, _
ByVal UBRow As Long, _
ByVal LBCol As Long, _
ByVal UBCol As Long, _
Optional ByVal bSkipFields As Boolean = False)
As Variant

Dim hFile As Long
Dim r As Long
Dim c As Long
Dim varWaste

hFile = FreeFile

Open txtFile For Input As #hFile

On Error Resume Next

If bSkipFields = False Then
For r = LBRow To UBRow
For c = LBCol To UBCol
Input #hFile, arr(r, c)
Next
Next
Else
For c = LBCol To UBCol
Input #hFile, varWaste
Next
For r = LBRow To UBRow
For c = LBCol To UBCol
Input #hFile, arr(r, c)
Next
Next
End If

Close #hFile

OpenTextFileToArray = arr

End Function


Sub SaveArrayToText2(ByVal txtFile As String, _
ByRef arr As Variant, _
Optional ByVal LBRow As Long = -1, _
Optional ByVal UBRow As Long = -1, _
Optional ByVal LBCol As Long = -1, _
Optional ByVal UBCol As Long = -1, _
Optional ByRef fieldArr As Variant)

'this one organises the text file like
'a table by inserting the right line breaks
'------------------------------------------
Dim r As Long
Dim c As Long
Dim hFile As Long

If LBRow = -1 Then
LBRow = LBound(arr, 1)
End If

If UBRow = -1 Then
UBRow = UBound(arr, 1)
End If

If LBCol = -1 Then
LBCol = LBound(arr, 2)
End If

If UBCol = -1 Then
UBCol = UBound(arr, 2)
End If

hFile = FreeFile

Open txtFile For Output As hFile

If IsMissing(fieldArr) Then
For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next
Next
Else
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, fieldArr(c)
Else
Write #hFile, fieldArr(c);
End If
Next
For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next
Next
End If

Close #hFile

End Sub


Sub InsertLineAtBeginningTexFile(ByVal strFile As String, ByVal strLine As
String)

Dim FFile As Integer
Dim FileContents As String
Dim NewString As String

FFile = FreeFile
Open strFile For Binary As #FFile
FileContents = Space(FileLen(strFile))
Get #FFile, , FileContents
Close #FFile

NewString = strLine & vbCrLf
FileContents = NewString & FileContents

Open strFile For Binary As #FFile
Put #FFile, , FileContents
Close #FFile

End Sub


Function GetFieldsFromText(ByVal strFile As String, ByVal lCols As Long) As
String

Dim hFile As Long
Dim strTemp As String
Dim strResult As String
Dim c As Long

hFile = FreeFile

Open strFile For Input As #hFile

On Error Resume Next

For c = 1 To lCols
Input #hFile, strTemp
If c = 1 Then
strResult = strTemp
Else
strResult = strResult & ", " & strTemp
End If
Next

Close #hFile

GetFieldsFromText = strResult

End Function



RBS



"onedaywhen" wrote in message
oups.com...

RB Smissaert wrote:
You could try loading your data into an ADO recordset and sorting
it
there.
Google for "disconnected recordset" and ADO

Thanks, but I have tried that already and it turned out to be about
twice
as slow.

To be fair, you are not doing as Tim suggested in your code, which has
too many missing dependencies (e.g. sub procedure SaveArrayToText2) to
test <g.

Rather than fabricating a recordset, your code appears to fabricate a
text file. FWIW I don't think your recordset ever gets opened/populated
because the SELECT..INTO..FROM syntax does not return a rowset.

BTW do you have a business requirement to use text files as databases?
Fabricating an .mdb file would yield better performance but I still
have your PATIENT.txt and ENTRY.txt files from way back when to create
an example JOIN between text files.

Jamie.

--

Hi,

I think I worked this all out now.
Although it will need making an extra (the array holding the values to sort
on)

You could assign to new array sorted to the old one (depending on your needs).
arr = VSORTArray(arr,...)

Note that in cases of big arrays to sort and depending on the problem (you know,
I don't), it might be a good idea to look at VSORT.IDX function which only
returns 1 column wide of INDEXES, that is pointers to the indices of the 'rows'
as if they were sorted. It's a very powerful function.

Regards,

Daniel M.

RB Smissaert wrote:
OK, I include the missing dependencies, so you can test.

There are still some missing ones which I could figure out i.e.
TempTablesFolder, TempTextConn, ShowStatement and bFileExists. Oh yeah,
then there's the gazillion row array which would prove more difficult
<g.

What sort of absolute times are involved here? I tested your code on a
10K row 2D array and it completed in under 300 milliseconds so I'll
pass on trying to halve this time.

The reason I use text files is that people that use my software
sometimes
have no Access.

If you have ADO you don't need the MS Access app to create, maintain
and use Jet .mdb databases. But that's another story.

The other thing is that it surprisingly appears just as
fast.

Agreed.

If you can convince me that Access is faster I might have another
look
at using that.

I was BTW'ing generally rather than for this particular issue <g. I
could probably convince you that a Jet database has better data typing,
data/referential integrity features, SQL syntax support, security, etc
but then you didn't ask for that.

One advantage your text file approach has is the *lack* of data typing
- with a fabricated recordset you'd have to choose a data type to use
for a column which could affect its sort order e.g. numerics sorted as
text.

Jamie.

--

Yes, sorry, I left a few in the


The line ShowStatement strQuery can just be deleted.

Then there are a number of Public variables:

strLocalDrive will normally be "C"

TempTextConn = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strLocalDrive &
":\RBSSynergyReporting\TempTables\;" & _
"Extended Properties=Text;"

TempTablesFolder = _
strLocalDrive & ":\RBSSynergyReporting\TempTables\"

And then the simple function:

Function bFileExists(strFile As String) As Boolean
bFileExists = (Len(Dir(strFile)) 0)
End Function

I think now you could make it work.

I remember you telling me about running a .mdb file without Access. Must
have look at that
one day. For now I am quite happy with the text files. I agree the sorting
is not slow as it is.


RBS


"onedaywhen" wrote in message
ups.com...
RB Smissaert wrote:
OK, I include the missing dependencies, so you can test.

There are still some missing ones which I could figure out i.e.
TempTablesFolder, TempTextConn, ShowStatement and bFileExists. Oh yeah,
then there's the gazillion row array which would prove more difficult
<g.

What sort of absolute times are involved here? I tested your code on a
10K row 2D array and it completed in under 300 milliseconds so I'll
pass on trying to halve this time.

The reason I use text files is that people that use my software
sometimes
have no Access.

If you have ADO you don't need the MS Access app to create, maintain
and use Jet .mdb databases. But that's another story.

The other thing is that it surprisingly appears just as
fast.

Agreed.

If you can convince me that Access is faster I might have another
look
at using that.

I was BTW'ing generally rather than for this particular issue <g. I
could probably convince you that a Jet database has better data typing,
data/referential integrity features, SQL syntax support, security, etc
but then you didn't ask for that.

One advantage your text file approach has is the *lack* of data typing
- with a fabricated recordset you'd have to choose a data type to use
for a column which could affect its sort order e.g. numerics sorted as
text.

Jamie.

--

I have come across one major problem and that is that the VSORT routine
will change 0-based arrays to 1-based arrays. I have searched everywhere
about this, but couldn't find anything about it. I have e-mailed Laurent
Longre
and maybe he can help out.
Had a look at the help about VSORT.IDX, but not sure how it would help me
sorting a 2-D array, particularly an 0-based 2-D array where I want to keep
the
base at 0.

RBS


"Daniel.M" wrote in message
...
Hi,

I think I worked this all out now.
Although it will need making an extra (the array holding the values to
sort
on)

You could assign to new array sorted to the old one (depending on your
needs).
arr = VSORTArray(arr,...)

Note that in cases of big arrays to sort and depending on the problem (you
know,
I don't), it might be a good idea to look at VSORT.IDX function which only
returns 1 column wide of INDEXES, that is pointers to the indices of the
'rows'
as if they were sorted. It's a very powerful function.

Regards,

Daniel M.

assume the indexes are in a 1 based array named arrIdx

msgbox arr(arrIdx(5)-1,7)

will return the 5th item/row, 8th column from the original array as if it
had been sorted.

This assumes the 1 based array holds index numbers as if the original array
were 1-based. If not, then remove the -1.

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
I have come across one major problem and that is that the VSORT routine
will change 0-based arrays to 1-based arrays. I have searched everywhere
about this, but couldn't find anything about it. I have e-mailed Laurent
Longre
and maybe he can help out.
Had a look at the help about VSORT.IDX, but not sure how it would help me
sorting a 2-D array, particularly an 0-based 2-D array where I want to
keep
the
base at 0.

RBS


"Daniel.M" wrote in message
...
Hi,

I think I worked this all out now.
Although it will need making an extra (the array holding the values to
sort
on)

You could assign to new array sorted to the old one (depending on your
needs).
arr = VSORTArray(arr,...)

Note that in cases of big arrays to sort and depending on the problem
(you
know,
I don't), it might be a good idea to look at VSORT.IDX function which
only
returns 1 column wide of INDEXES, that is pointers to the indices of the
'rows'
as if they were sorted. It's a very powerful function.

Regards,

Daniel M.

Tom,

I had worked it out now.
The VSORT.IDX function does the trick.
This is my wrapper function for this now and it works fine:


Function VSORT_IDX_Array(ByRef arr As Variant, _
ByVal btCol1 As Byte, _
ByVal strSortType1 As String, _
Optional ByVal btCol2 As Byte = 0, _
Optional ByVal strSortType2 As String = "", _
Optional ByVal btCol3 As Byte = 0, _
Optional ByVal strSortType3 As String = "") As
Variant

'------------------------------------------------------------------
'http://longre.free.fr/english/
'Uses Laurent Longre's VSORT.IDX function in the .xll add-in MoreFunc
'Done up to 3 columns here, but can be done up to 14 columns
'------------------------------------------------------------------
'will sort an 0-based or 1-based 2-D array with up to 3 sort keys
'the field key has to be supplied as a byte, where the first column
'of the array is 1, even if it is an 0-based array
'the sort type has to be given as "a", "A" , "b" or "B"
'examples:
'sorting on 1 field: arr2 = VSORT_IDX_Array(arr, 1, "A")
'sorting on 2 fields: arr2 = VSORT_IDX_Array(arr, 2, "D", 5, "A")
'------------------------------------------------------------------

Dim i As Long
Dim c As Long
Dim LB1 As Long
Dim UB1 As Long
Dim LB2 As Long
Dim UB2 As Long
Dim arrKey1
Dim arrKey2
Dim arrKey3
Dim btSortType1 As Byte
Dim btSortType2 As Byte
Dim btSortType3 As Byte
Dim arrIndex
Dim arrFinal

LB1 = LBound(arr)
UB1 = UBound(arr)
LB2 = LBound(arr, 2)
UB2 = UBound(arr, 2)

ReDim arrFinal(LB1 To UB1, LB2 To UB2)

'make the array for key 1
'------------------------
ReDim arrKey1(LB1 To UB1, LB1 To LB1)
For i = LB1 To UB1
arrKey1(i, LB1) = arr(i, btCol1 - (1 - LB1))
Next

'set the sort type for key 1
'---------------------------
If UCase(strSortType1) = "A" Then
btSortType1 = 1
Else
btSortType1 = 0
End If

If Not btCol2 = 0 Then
'make the array for key 2
'------------------------
ReDim arrKey2(LB1 To UB1, LB1 To LB1)

For i = LB1 To UB1
arrKey2(i, LB1) = arr(i, btCol2 - (1 - LB1))
Next

'set the sort type for key 2
'---------------------------
If UCase(strSortType2) = "A" Then
btSortType2 = 1
Else
btSortType2 = 0
End If
End If

If Not btCol3 = 0 Then
'make the array for key 3
'------------------------
ReDim arrKey3(LB1 To UB1, LB1 To LB1)
For i = LB1 To UB1
arrKey3(i, LB1) = arr(i, btCol3 - (1 - LB1))
Next

'set the sort type for key 3
'---------------------------
If UCase(strSortType3) = "A" Then
btSortType3 = 1
Else
btSortType3 = 0
End If
End If

If Not btCol3 = 0 Then
'3 fields to sort on
'-------------------
arrIndex = Application.Run([VSORT.IDX], _
arrKey1, btSortType1, _
arrKey2, btSortType2, _
arrKey3, btSortType3)
Else
'2 fields to sort on
'-------------------
If Not btCol2 = 0 Then
arrIndex = Application.Run([VSORT.IDX], _
arrKey1, btSortType1, _
arrKey2, btSortType2)
Else
'1 field to sort on
'------------------
arrIndex = Application.Run([VSORT.IDX], _
arrKey1, btSortType1)
End If
End If

For i = LBound(arrIndex) To UBound(arrIndex)
For c = LB2 To UB2
arrFinal(i - (1 - LB1), c) = arr(arrIndex(i, 1) - (1 - LB1), c)
Next
Next

VSORT_IDX_Array = arrFinal

End Function

Just looking at this, perhaps I might as well use the VSORT function as I
have to transfer the array
now anyhow. If I use the VSORT I can avoid doing the array transfer if a
1-based array was given, thereby
speeding this up a bit.
I think the speed gain is not 4 to 5 times as my test was not up to scratch.
Seems more like 50% faster.
Still, it is easy to sort on multiple fields.


RBS


"Tom Ogilvy" wrote in message
...
assume the indexes are in a 1 based array named arrIdx

msgbox arr(arrIdx(5)-1,7)

will return the 5th item/row, 8th column from the original array as if it
had been sorted.

This assumes the 1 based array holds index numbers as if the original
array
were 1-based. If not, then remove the -1.

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
I have come across one major problem and that is that the VSORT routine
will change 0-based arrays to 1-based arrays. I have searched everywhere
about this, but couldn't find anything about it. I have e-mailed Laurent
Longre
and maybe he can help out.
Had a look at the help about VSORT.IDX, but not sure how it would help me
sorting a 2-D array, particularly an 0-based 2-D array where I want to
keep
the
base at 0.

RBS


"Daniel.M" wrote in message
...
Hi,

I think I worked this all out now.
Although it will need making an extra (the array holding the values to
sort
on)

You could assign to new array sorted to the old one (depending on your
needs).
arr = VSORTArray(arr,...)

Note that in cases of big arrays to sort and depending on the problem
(you
know,
I don't), it might be a good idea to look at VSORT.IDX function which
only
returns 1 column wide of INDEXES, that is pointers to the indices of
the
'rows'
as if they were sorted. It's a very powerful function.

Regards,

Daniel M.

This will be faster if it is a 1-based array:


Function VSORTArray(ByRef arr As Variant, _
ByVal btCol1 As Byte, _
ByVal strSortType1 As String, _
Optional ByVal btCol2 As Byte = 0, _
Optional ByVal strSortType2 As String = "", _
Optional ByVal btCol3 As Byte = 0, _
Optional ByVal strSortType3 As String = "") As Variant

'------------------------------------------------------------------
'http://longre.free.fr/english/
'Uses Laurent Longre's VSort function in the .xll add-in MoreFunc
'Will be about 4 to 5 times faster than a quicksort and can sort
'on multiple columns.
'Done up to 3 columns here, but can be done up to 14 columns
'------------------------------------------------------------------
'will sort an 0-based or 1-based 2-D array with up to 3 sort keys
'the field key has to be supplied as a byte, where the first column
'of the array is 1, even if it is an 0-based array
'the sort type has to be given as "a", "A" , "b" or "B"
'examples:
'sorting on 1 field: arr2 = VSORTArray(arr, 1, "A")
'sorting on 2 fields: arr2 = VSORTArray(arr, 2, "D", 5, "A")
'------------------------------------------------------------------

Dim i As Long
Dim c As Long
Dim LB1 As Long
Dim UB1 As Long
Dim LB2 As Long
Dim UB2 As Long
Dim arrKey1
Dim arrKey2
Dim arrKey3
Dim btSortType1 As Byte
Dim btSortType2 As Byte
Dim btSortType3 As Byte
Dim arrFinal
Dim arrFinal2

LB1 = LBound(arr)
UB1 = UBound(arr)
LB2 = LBound(arr, 2)
UB2 = UBound(arr, 2)

'make the array for key 1
'------------------------
ReDim arrKey1(LB1 To UB1, LB1 To LB1)
For i = LB1 To UB1
arrKey1(i, LB1) = arr(i, btCol1 - (1 - LB1))
Next

'set the sort type for key 1
'---------------------------
If UCase(strSortType1) = "A" Then
btSortType1 = 1
Else
btSortType1 = 0
End If

If Not btCol2 = 0 Then
'make the array for key 2
'------------------------
ReDim arrKey2(LB1 To UB1, LB1 To LB1)

For i = LB1 To UB1
arrKey2(i, LB1) = arr(i, btCol2 - (1 - LB1))
Next

'set the sort type for key 2
'---------------------------
If UCase(strSortType2) = "A" Then
btSortType2 = 1
Else
btSortType2 = 0
End If
End If

If Not btCol3 = 0 Then
'make the array for key 3
'------------------------
ReDim arrKey3(LB1 To UB1, LB1 To LB1)
For i = LB1 To UB1
arrKey3(i, LB1) = arr(i, btCol3 - (1 - LB1))
Next

'set the sort type for key 3
'---------------------------
If UCase(strSortType3) = "A" Then
btSortType3 = 1
Else
btSortType3 = 0
End If
End If

If Not strSortType3 = "" Then
'3 fields to sort on
'-------------------
arrFinal = Application.Run([VSORT], arr, _
arrKey1, btSortType1, _
arrKey2, btSortType2, _
arrKey3, btSortType3)
Else
'2 fields to sort on
'-------------------
If Not strSortType2 = "" Then
arrFinal = Application.Run([VSORT], arr, _
arrKey1, btSortType1, _
arrKey2, btSortType2)
Else
'1 field to sort on
'------------------
arrFinal = Application.Run([VSORT], _
arr, arrKey1, btSortType1)
End If
End If

If LB1 = 0 Then
'to revert back to an 0-based array
'----------------------------------
ReDim arrFinal2(LB1 To UB1, LB2 To UB2)
For i = LBound(arrFinal) To UBound(arrFinal)
For c = LBound(arrFinal, 2) To UBound(arrFinal, 2)
arrFinal2(i - (1 - LB1), c - (1 - LB2)) = arrFinal(i, c)
Next
Next
VSORTArray = arrFinal2
Else
VSORTArray = arrFinal
End If

End Function

One thing I noticed that the number of rows in the array to sort can't go
above 65536, the number of rows in the sheet.
It seems that these functions are geared towards sheet ranges (always
produce 1-based arrays, limit of 65536 rows)
even though they can be used for arrays. The benefit speedwise would come
into play with arrays larger than this, unless maybe you have slow hardware.
The main benefit though is that you can sort on multiple fields.


RBS


"Tom Ogilvy" wrote in message
...
assume the indexes are in a 1 based array named arrIdx

msgbox arr(arrIdx(5)-1,7)

will return the 5th item/row, 8th column from the original array as if it
had been sorted.

This assumes the 1 based array holds index numbers as if the original
array
were 1-based. If not, then remove the -1.

--
Regards,
Tom Ogilvy

"RB Smissaert" wrote in message
...
I have come across one major problem and that is that the VSORT routine
will change 0-based arrays to 1-based arrays. I have searched everywhere
about this, but couldn't find anything about it. I have e-mailed Laurent
Longre
and maybe he can help out.
Had a look at the help about VSORT.IDX, but not sure how it would help me
sorting a 2-D array, particularly an 0-based 2-D array where I want to
keep
the
base at 0.

RBS


"Daniel.M" wrote in message
...
Hi,

I think I worked this all out now.
Although it will need making an extra (the array holding the values to
sort
on)

You could assign to new array sorted to the old one (depending on your
needs).
arr = VSORTArray(arr,...)

Note that in cases of big arrays to sort and depending on the problem
(you
know,
I don't), it might be a good idea to look at VSORT.IDX function which
only
returns 1 column wide of INDEXES, that is pointers to the indices of
the
'rows'
as if they were sorted. It's a very powerful function.

Regards,

Daniel M.