Function sbGSort(vA As Variant, _
Optional sOrd As String = "A", _
Optional sCT As String = "S", _
Optional sPrio As String = "123456789") As Variant
'Performs a gnomesort on one- or two-dimensional array vA.
'Characters in sOrd define sort order for each column:
'A - ascending, D - descending
'Characters in sCT define comparison type for each column:
'S - string, N - numerical
'Characters in sPrio define sort priorities of columns, for
'123 - sort by first, then second, then third column
'521 - sort by fifth, then second, then first column
'Note that the maximum count of characters in sOrd or sPrio
'defines on how many columns the sort comparisons will be
'applied. If sOrd = "AAAA" and sPrio = "3", for example, the
'sort comparison will be on the four columns 3 1 2 4 in this
'Please note that this is a fairly weak sort algorithm
'because its sort time is expected to be quadratic. But its
'supposed to be used on small ranges or arrays only.
'Larger ranges or arrays should be sorted by Excel's internal
'sort algorithm via a subroutine.
'Reverse("moc.LiborPlus.www") PB 07-Mar-2009 V0.11
Dim sComparisonType As String
Dim bSwap As Boolean 'Indicates whether we need to swap rows
Dim bOrd As Boolean 'FALSE = Ascending sort order
With Application.WorksheetFunction
vT = .Transpose(.Transpose(vA))
lPrio = .Min(n, .Max(Len(sOrd), Len(sPrio)))
'Process sort priorities of columns (if given)
Set obj = CreateObject("Scripting.Dictionary")
sbGSort = CVErr(xlErrValue)
ReDim lPriority(1 To lPrio) As Long
Case "1", "2", "3", "4", "5", "6", "7", "8", "9"
lPriority(i) = Asc(sC) - Asc("0")
obj.Item(lPriority(i)) = i
sbGSort = CVErr(xlErrValue)
'Process sort order for each column (if given)
sbGSort = CVErr(xlErrValue)
If sC <> "A" And sC <> "D" Then
sbGSort = CVErr(xlErrValue)
sSortOrder = sSortOrder & sC
'Process comparison type for each column
sbGSort = CVErr(xlErrValue)
If IsEmpty(vT(j, k)) Then vT(j, k) = 0
If IsEmpty(vT(j, k)) Then vT(j, k) = ""
sbGSort = CVErr(xlErrValue)
sComparisonType = sComparisonType & sC
'Compare row i with row i+1
If Mid(sSortOrder, j, 1) = "A" Then
If Mid(sComparisonType, j, 1) = "N" Then
If vT(i, lPriority(j)) + 0 > _
vT(i + 1, lPriority(j)) + 0 Then
ElseIf vT(i, lPriority(j)) + 0 < _
vT(i + 1, lPriority(j)) + 0 Then
If vT(i, lPriority(j)) & "" > vT(i + 1, _
ElseIf vT(i, lPriority(j)) & "" < vT(i + _
1, lPriority(j)) & "" Then