R
RB Smissaert
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
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