Is there a way to sort cell addresses from top left to bottom right?

e.g.

Dim targetAddress As String

targetAddress = "$E$12,$B$11:$C$12,$G$14,$F$2,$F9" 'randomly selected cells

I want to sort targetAddress from top left to bottom right as follows:

"$F$2,$F$9,$B$11:$C$12,$E$12,$G$14"

CodePudding user response：

Sorting the cell addresses of a union

My first thought was that a union is automatically sorted by Excel, but I was proven wrong. Here a proposal using Quicksort from user "jorge-ferreira".

After rereading the question I found that the below
solution is NOT the answer which was searched for. ;-(

Option Explicit

Sub sort_union()

    Dim myRange As Range
    Dim myCell As Range
    Dim myArray(100) As String
    Dim iCt As Integer
    Dim maxCt As Long
    
    Set myRange = Union(Range("$E$12"), Range("$B$11:$C$12"), Range("$G$14"), Range("$F$2"), Range("$F9"))
    
    Debug.Print myRange.Address
    
    iCt = 0
    Debug.Print vbCrLf & "ORIGINAL:"
    For Each myCell In myRange
        myArray(iCt) = myCell.Address
        Debug.Print iCt & " : " & myCell.Address & " =========> " & myArray(iCt)
        iCt = iCt   1
    Next myCell
    maxCt = iCt - 1
    
    Call QuickSort(myArray, 0, maxCt)

    Set myRange = Nothing

    Debug.Print vbCrLf & "SORTED:"
    Set myRange = Range(myArray(0))
    Debug.Print 0, myArray(0)
    For iCt = 1 To maxCt
        Set myRange = Union(myRange, Range(myArray(iCt)))
        Debug.Print iCt, myArray(iCt)
    Next iCt

    Debug.Print vbCrLf & myRange.Address
End Sub

'using quicksort from
'https://stackoverflow.com/questions/152319/vba-array-sort-function

Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
  Dim pivot   As Variant
  Dim tmpSwap As Variant
  Dim tmpLow  As Long
  Dim tmpHi   As Long

  tmpLow = inLow
  tmpHi = inHi

  pivot = vArray((inLow   inHi) \ 2)

  While (tmpLow <= tmpHi)
     While (vArray(tmpLow) < pivot And tmpLow < inHi)
        tmpLow = tmpLow   1
     Wend

     While (pivot < vArray(tmpHi) And tmpHi > inLow)
        tmpHi = tmpHi - 1
     Wend

     If (tmpLow <= tmpHi) Then
        tmpSwap = vArray(tmpLow)
        vArray(tmpLow) = vArray(tmpHi)
        vArray(tmpHi) = tmpSwap
        tmpLow = tmpLow   1
        tmpHi = tmpHi - 1
     End If
  Wend

  If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
  If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub

Here the output of the Immediate Window:

$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

ORIGINAL:
0 : $E$12 =========> $E$12
1 : $B$11 =========> $B$11
2 : $C$11 =========> $C$11
3 : $B$12 =========> $B$12
4 : $C$12 =========> $C$12
5 : $G$14 =========> $G$14
6 : $F$2 =========> $F$2
7 : $F$9 =========> $F$9

SORTED:
 0            $B$11
 1            $B$12
 2            $C$11
 3            $C$12
 4            $E$12
 5            $F$2
 6            $F$9
 7            $G$14

$B$11:$C$12,$E$12,$F$2,$F$9,$G$14

CodePudding user response：

Sorting the cell addresses of a union with ascending row and descending column

Straight forward approach using the inbuilt sort of Excel:

Option Explicit

Sub sort_union()
    Dim myRange As Range
    Dim myCell As Range
    Dim iCt As Integer
    Dim maxCt As Integer
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("RangeSort").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Worksheets.Add.Name = "RangeSort"
    
    Set myRange = Union(Range("$E$12"), Range("$B$11:$C$12"), _
        Range("$G$14"), Range("$F$2"), Range("$F9"))
    
    Debug.Print vbCrLf & "ORIGINAL:"
    Debug.Print myRange.Address
    
    iCt = 1
    Range("A1") = "Address"
    Range("B1") = "Row"
    Range("C1") = "Column"
    
    For Each myCell In myRange
        Range("A1").Offset(iCt, 0) = myCell.Address
        Range("B1").Offset(iCt, 0) = myCell.Row
        Range("C1").Offset(iCt, 0) = myCell.Column
        iCt = iCt   1
    Next myCell
    maxCt = iCt - 1
    
    Call SortCurrentRegion
    
    Set myRange = Range(Range("A2").Value)
    'Debug.Print iCt; myRange.Address
    'create sorted union
    For iCt = 2 To maxCt
        Set myRange = Union(myRange, Range(Range("A1").Offset(iCt, 0)))
        Debug.Print iCt; myRange.Address
    Next iCt
    
    Debug.Print vbCrLf & "SORTED:"
    Debug.Print myRange.Address


    'Delete Sheet "RangeSort"
    'On Error Resume Next
    'Application.DisplayAlerts = False
    'Sheets("RangeSort").Delete
    'Application.DisplayAlerts = True
    'On Error GoTo 0
    
End Sub


Sub SortCurrentRegion()
    Dim sortRange As Range
    Set sortRange = ActiveSheet.Range("A1").CurrentRegion
    
    With ActiveSheet.Sort
        .SortFields.Clear
        
        'sort "Col B" = "Row" ascending
        .SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
    
        'sort "Col C" = "Column" descending
        .SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, _
            Order:=xlDescending, DataOption:=xlSortNormal
    
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Here the output of the Immediate Window:

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

SORTED:
$F$2,$F$9,$E$12,$B$11:$C$12,$G$14

Why is $E$12 in front of $B$11:$C$12?
In the output of the Immediate Window we see that by adding address $C$11 to the union the range $B$11:$C$12 changes to the end of the union! ;-(

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F$9

 2 $F$2,$F$9
 3 $F$2,$F$9,$C$11
 4 $F$2,$F$9,$B$11:$C$11
 5 $F$2,$F$9,$B$11:$C$11,$E$12
 6 $F$2,$F$9,$B$11:$C$11,$E$12,$C$12
 7 $F$2,$F$9,$E$12,$B$11:$C$12            
 ^^-- $C$11 is added to the union here
 8 $F$2,$F$9,$E$12,$B$11:$C$12,$G$14
 ^^-- $B$11:$C$12 moved to the end of the union automatically

SORTED:
$F$2,$F$9,$E$12,$B$11:$C$12,$G$14

CodePudding user response：

Sorting the cell addresses of a union with ascending row and descending column

Finally the answer which was asked for! ;-)

Option Explicit

Sub Split_and_Sort()

    Dim myRangeStr As String
    Dim myRangeArr() As String
    Dim myRange As Range
    Dim iCt As Integer
    Dim maxCt As Integer
    
    myRangeStr = "$E$12,$B$11:$C$12,$G$14,$F$2,$F9"
    myRangeArr = Split(myRangeStr, ",")
    
    Debug.Print vbCrLf & "ORIGINAL:"
    Debug.Print myRangeStr & vbCrLf
    
    iCt = 1
    Range("A1") = "Address"
    Range("B1") = "Row"
    Range("C1") = "Column"
    
    For iCt = 0 To UBound(myRangeArr)
        If myRangeArr(iCt) <> "" Then
            'Debug.Print iCt; " "; myRangeArr(iCt)
            maxCt = iCt   1
            
            Range("A1").Offset(iCt   1, 0) = myRangeArr(iCt)
            Range("B1").Offset(iCt   1, 0) = Range(myRangeArr(iCt)).Row
            Range("C1").Offset(iCt   1, 0) = Range(myRangeArr(iCt)).Column
        End If
    Next iCt

    Call SortCurrentRegion
    
    Set myRange = Range(Range("A2").Value)
    'iCt = 1: Debug.Print: Debug.Print iCt; myRange.Address
    
    'create sorted union
    For iCt = 2 To maxCt
        Set myRange = Union(myRange, Range(Range("A1").Offset(iCt, 0)))
        Debug.Print iCt; myRange.Address
    Next iCt
    
    Debug.Print vbCrLf & "SORTED:"
    Debug.Print myRange.Address

End Sub

Sub SortCurrentRegion()
    Dim sortRange As Range
    Set sortRange = ActiveSheet.Range("A1").CurrentRegion
    
    With ActiveSheet.Sort
        .SortFields.Clear
        
        'sort "Col B" = "Row" ascending
        .SortFields.Add2 Key:=Range("B1"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
    
        'sort "Col C" = "Column" descending
        .SortFields.Add2 Key:=Range("C1"), SortOn:=xlSortOnValues, _
            Order:=xlDescending, DataOption:=xlSortNormal
    
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Here the output of the Immediate Window:

ORIGINAL:
$E$12,$B$11:$C$12,$G$14,$F$2,$F9

SORTED:
$F$2,$F$9,$B$11:$C$12,$E$12,$G$14