Sorting a Range with VBA

[MamboKing]

In VBA I need to sort the rows of a Range (based on the content of one column), place the sorted results into a Variant matrix and display the matrix on the Excel sheet with the regular Ctrl-Shft-Enter.


I did the following and it comes out with the error msg #VALUE! in each cell:

Dim theMatrix() As Variant
theMatrix = Range("B2", "H7").Sort(Key1:=Columns(4), Orientation:=xlSortRows)
Then I recorded a Macro that works perfectly fine stand-alone. It's here below.


But, if I cut/paste these exact same lines into my VBA, it does not work at all!!

Range("B2:H6").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

I'm desperately seeking help!

[mikerickson]

.Sort is a method, not a function. Therefore setting theMatix to Range.Sort won't work.

Dim theMatrix as Variant

With ThisWorkBook.Sheets("Sheet1").Range("B2:H6")
    .Sort Key1:=.Range("D2"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

    theMatrix = .Value
End With

[david000]

and display the matrix on the Excel sheet with the regular Ctrl-Shft-Enter.

If it MUST be array entered you could still get the effect by using a "named range" I suppose.

Sub ArrayFormula()
Dim theMatrix As Variant
With ThisWorkbook.Sheets("Sheet1").Range("B2:H6")
    .Sort Key1:=.Range("D2"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
.Name = "theMatrix"
End With
    ThisWorkbook.Sheets("Sheet2").Range("a1") _
    .Resize(Range("thematrix").Rows.Count, Range("thematrix").Columns.Count) _
    .FormulaArray = "=theMatrix"
End Sub

[mikerickson]

The problem with casting it as a function is that when called from the spreadsheet, functions can not change the environment. (i.e. they cannot sort cells).
A sub that copied B2:H6 to another range and then sorted that range (leaving B2:H6 alone) could be written, but it could not be invoked by a formula in a cell.

[MamboKing]

Mike, David, Thanks but...

Neither codes work. Unfortunately I must order that matrix in VBA code, w/o displaying on the Excel sheet.

David:
>> but it could not be invoked by a formula in a cell.

I'm not in a cell. It will be a button calling the VBA. But it might be the same thing.

Best Regards

[mikerickson]

This UDF returns an array of the values of the inputRange sorted by the keyColumn

Putting the array formula {=QSortedRange(B2:H6,3,TRUE)} in P2:V6 will show the range B2:H6,
sorted descending by column3 (relative to B2, that is column D).

It can also be called from a VB routine and not shown on the sheet.

Option Explicit
Public imageArray As Variant
Public keyCol As Long

Function QSortedRange(inputRange As Range, Optional keyColumn As Long, Optional descending As Boolean) As Variant
    Dim RowArray As Variant
    Dim outRRay As Variant
    Dim i As Long, j As Long
    If keyColumn = 0 Then keyColumn = 1
    If inputRange.Columns.Count < keyColumn Then
        QSortedRange = CVErr(xlErrRef)
    Else
        keyCol = keyColumn
        imageArray = inputRange.Value
        ReDim RowArray(1 To inputRange.Rows.Count)
        For i = 1 To UBound(RowArray)
            RowArray(i) = i
        Next i
        Call sortQuickly(RowArray, descending)
        outRRay = imageArray
        For i = 1 To UBound(outRRay, 1)
            For j = 1 To UBound(outRRay, 2)
                outRRay(i, j) = imageArray(RowArray(i), j)
            Next j
        Next i
        QSortedRange = outRRay
    End If
End Function

Sub sortQuickly(ByRef inRRay As Variant, Optional ByVal descending As Boolean, Optional ByVal low As Long, Optional ByVal high As Long)
    Dim pivot As Variant
    Dim i As Long, pointer As Long
    If low = 0 Then low = LBound(inRRay)
    If high = 0 Then high = UBound(inRRay)
pointer = low
Call Swap(inRRay, (low + high) / 2, high)
    pivot = inRRay(high)
For i = low To high - 1
        If LT(inRRay(i), pivot) Xor descending Then
            Call Swap(inRRay, i, pointer)
            pointer = pointer + 1
        End If
    Next i
    Call Swap(inRRay, pointer, high)
    If low < pointer - 1 Then
        Call sortQuickly(inRRay, descending, low, pointer - 1)
    End If
    If pointer + 1 <= high Then
        Call sortQuickly(inRRay, descending, pointer + 1, high)
    End If
End Sub

Function LT(aRow As Variant, bRow As Variant) As Boolean
    On Error GoTo excelComparison
    LT = (imageArray(aRow, keyCol) < imageArray(bRow, keyCol))
    On Error GoTo 0
    Exit Function
excelComparison:
    LT = aRow < bRow
    On Error GoTo 0
End Function

Sub Swap(ByRef inRRay, a As Long, b As Long)
    Dim temp As Variant
    temp = inRRay(a)
    inRRay(a) = inRRay(b)
    inRRay(b) = temp
End Sub

(Array formulas are confirmed with Ctrl-Shift-Enter (Cmd+Return for Mac))

[david000]

Mike,

That is freaking amazing!

Do a KB article on that.

[MamboKing]

I browsed intensively the web for something similar with no success.

It reallt works great! And fast!

At this point, since I could not see solutions for sorting the Range,
I put my data in a Variant matrix.

Let's see if I can tweak the QSortedRange and make it working for
a Variant matrix. Eventually, I'll go back to Range.

Mike, Thanks so much!

[mikerickson]

Thanks.

It's the combination of a couple of ideas.

1) The core of many sorts is the line

If a < b then Swap (a,b)

A custom boolean function LT (LessThan) can be substituted for Excel's < .

If LT(a,b) then Swap (a,b)

2) When sorting a 2D array, Swap can be a problem. I believe that in C (?) and other languages, that whole row swapping is possible. In VB, I know of now way other than looping to swap two rows of a 2D arrray. Swap is performed so often that execution time increases almost linearly with the number of columns using this approach.

An alternative to this is to create an array of row numbers {1,2,3,...UBound(dataArray,1)} and sort that array using a custom LT function. The LT used above compares the keyColumn values of each row of the dataArray to determing "less than".
(Alternative LT's can be used (e.g. row1 is "less than" row2 if SUM(row1) < SUM(row2) )

Sorting the array of row numbers adds one-time loops to a) create the array of row numbers. b) translate the sorted array of rows into a 2-D sorted result array. The execution time is independent of the number of columns.

3) QuickSort

4) A function that returns a Variant Array can either be entered an array formula or used as the first argument of INDEX.

I'm glad to help.

[mikerickson]

This version will take either a Range or a 2-D array as its first argument.
[VBA]Function QSortedArray(ByVal inputRange As Variant, Optional keyColumn As Long, Optional descending As Boolean) As Variant
Dim RowArray As Variant
Dim outRRay As Variant
Dim i As Long, j As Long, size As Long

If keyColumn = 0 Then keyColumn = 1

Rem input array vs range handeling
On Error GoTo HaltFunction
Select Case TypeName(inputRange)
Case Is = "Range"
If inputRange.Columns.Count < keyColumn Then
QSortedArray = CVErr(xlErrRef): Exit Function
Else
Set inputRange = Application.Intersect(inputRange, inputRange.Parent.UsedRange)
If inputRange Is Nothing Then
QSortedArray = Array(vbNullString): Exit Function
Else
imageArray = inputRange.Value
End If
End If

Case Is = "Variant()", "String()", "Double()", "Long()"
If UBound(inputRange, 2) < keyColumn Then
QSortedArray = Array(CVErr(xlErrRef)): Exit Function
Else
imageArray = inputRange
End If

Case Else
QSortedArray = CVErr(xlErrNA): Exit Function
End Select
On Error GoTo 0

Rem pass arguments to public variables
keyCol = keyColumn

Rem create array of row numbers {1,2,3,...,Rows.Count}
size = UBound(imageArray, 1)
ReDim RowArray(1 To size)
For i = 1 To size
RowArray(i) = i
Next i

Rem sort row numbers
Call sortQuickly(RowArray, descending)

Rem read imageArray with row order per the sorted RowArray
ReDim outRRay(1 To size, 1 To UBound(imageArray, 2))
For i = 1 To size
For j = 1 To UBound(outRRay, 2)
outRRay(i, j) = imageArray(RowArray(i), j)
Next j
Next i

QSortedArray = outRRay

Erase imageArray
HaltFunction:
On Error GoTo 0
End Function[/VBA]

[MamboKing]

Mike:

[MamboKing]

This version will take either a Range or a 2-D array as its first argument.

Mike,
I'm trying to using your Function QSortedArray. A question, if you could answer, please:

In case two or more elements of the keyColumn are equal, I see that the function does not default to any other column for those specific rows.

It happens that I need to default the sorting to Col 1 for the rows that have identical elements in my keyColumn (Col 9).

Do you know/have any function that can do that?
If not, how can I make VBA doing it through the Excel sort? (this action must be hidden)

Thanks Mike!

[mikerickson]

The posted function LT controls how the Sort works.
It is answering the question "True or False, row# aRow "is less than" row# bRow?"

Currently,
1) the error handeling is a left over. It can be removed. (If removed, CStr should be used to protect against error values (e.g. #DIV/0) in the data.)

2) LT answers its question with this line.[VBA]LT = (imageArray(aRow, keyCol) < imageArray(bRow, keyCol))[/VBA]and, as you noted, it returns False in case of a tie in the key column.
That line can be replaced with
[VBA]If (imageArray(aRow, keyCol) = imageArray(bRow, keyCol)) Then
LT = (imageArray(aRow, 1) < imageArray(bRow, 1))
Else
LT = (imageArray(aRow, keyCol) < imageArray(bRow, keyCol))
End If[/VBA]which looks to column 1 to resolve ties.

If you want the ability to specify the secondary column, a KeyColumn2 argument can be added to the UDF.

This will use column 1 values as the tie breaker.
[VBA]Function LT(aRow As Variant, bRow As Variant) As Boolean
If CStr(imageArray(aRow, keycol)) = CStr(imageArray(bRow, keycol)) Then
LT = CStr(imageArray(aRow, 1)) < CStr(imageArray(bRow, 1))
Else
LT = CStr(imageArray(aRow, keycol)) < CStr(imageArray(bRow, keycol))
End If
End Function[/VBA]

[mikerickson]

On further reflection, this version handles error values better than the post above.
[VBA]Function LT(aRow As Variant, bRow As Variant, Optional descending as Boolean) As Boolean
On Error Goto HaltFtn
LT = IsError(imageArray(aRow,keycol)+imageArray(aRow,1)) Imp descending
If imageArray(aRow, keycol) = imageArray(bRow, keycol) Then
LT = imageArray(aRow, 1) < imageArray(bRow, 1)
Else
LT = (imageArray(aRow, keycol) < imageArray(bRow, keycol))
End If
HaltFtn:
On Error Goto 0
End Function[/VBA]

The calling line in SortQuickly would become
[VBA]If LT(inRRay(i), pivot, descending) Xor descending Then [/VBA]