Formula to sort text

[DrBob]

Hi everyone.

I'm trying to find a formula that will automatically sort a 2 columns (surnames and forenames).

The surname is in column A, forename in column B. I want the sorted list to appear in columns C and D. Is this possible? Thanks in anticipation.

 

[DonkeyOte]

DrBob -- presumably the names are linked ?

Also are the combination of forename & surname unique or do they appear multiple times in A:B ?

 

[DrBob]

Linked and unique.

 

[mikerickson]

The array UDF here: http://www.vbaexpress.com/forum/showthread.php?t=20494
will return a sorted range.

 

[DrBob]

Great! I'll give it a try.

Thanks Mike.

 

[DrBob]

Brilliant! This is fantastic - only...I would like to sort from 'A to Z' not 'Z to A'. How could I change the code to make this happen?

 

[mikerickson]

There is no need to change the code. The UDF takes an (optional) descending argument. False (or omitted) it sorts ascending, True descending.

 

[DrBob]

Should have realised.

Thanks, Mike. You're a genius.

 

[DrBob]

A final thought, Mike:

Is it possible to sort by more than one column i.e. sort by column A and then by column B?

 

[mikerickson]

Funny you should ask that.
The fellow in the other thread asked the same thing, but about a different column.
This version accepts two keyColumn arguments (no independent control of ascending/descending)
The array formula =QSortedArray(A:B,1,2) should meet your needs.

Option Explicit
Public imageArray As Variant
Public keyCol As Long, keyCol2

Function QSortedArray(ByVal inputRange As Variant, Optional keyColumn As Long, Optional keyColumn2 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
    
    If keyColumn2 = 0 Then keyColumn2 = keyColumn
    If UBound(imageArray, 2) < keyColumn Then QSortedArray = CVErr(xlErrRef): Exit Function
    If UBound(imageArray, 2) < keyColumn2 Then QSortedArray = CVErr(xlErrRef): Exit Function
    keyCol = keyColumn
    keyCol2 = keyColumn2
    
    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
 
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, Optional Descending As Boolean) As Boolean
    On Error GoTo HaltFtn
    LT = Descending
    If imageArray(aRow, keyCol) = imageArray(bRow, keyCol) Then
        LT = imageArray(aRow, keyCol2) < imageArray(bRow, keyCol2)
    Else
        LT = (imageArray(aRow, keyCol) < imageArray(bRow, keyCol))
    End If
HaltFtn:
    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

This version also accepts an array as its first argument so one can play with TRANSPOSE to sort horizontaly.
Array formulas are entered with Ctrl-Shift-Enter (Cmd+Return for Mac)