Auto sorting a range of individual cells that span multiple columns

[PPRx]

I have a range of data (I13:K27) that I want to automatically sort in ascending order (using VBA) by individual cells, and not by rows. It would start at I13 and go to I27, then jump to J13 and go to J27, then finally jump to K13 and end at K27. This would be easy if everything was in one column, but it's necessary to split it up across three columns for the sake fitting on a single page when printing.

Any help is appreciated.

 

[Eric W]

Welcome to the MrExcel forum!

Try:

Sub Sort3Cols()
Dim MR As Range, it As Variant, i As Long

    Set MR = Range("I13:K27")
    With CreateObject("System.Collections.ArrayList")
        For Each it In MR
            .Add it.Value
        Next
        .Sort
        For i = 0 To MR.Cells.Count - 1
            MR.Offset(i Mod MR.Rows.Count, i \ MR.Rows.Count).Resize(1, 1) = .Item(i)
        Next i
    End With
            
End Sub

 

[Fuji]

If the range contains multiple data types like String, Numeric, Blanks etc.
1) If you prefer ArrayList then

Sub SortByArrayList()
    Dim a, e, n&, t&, x As Object
    With [i13:k27]
        If .Count = 1 Then Exit Sub
        a = .Value2
        With CreateObject("System.Collections.ArrayList")
            Set x = .Clone
            For Each e In a
                If e <> "" Then
                    If TypeName(e) = "String" Then
                        x.Add e
                    Else
                        .Add e
                    End If
                End If
            Next
            .Sort: x.Sort_2 CreateObject("System.Collections.CaseInsensitiveComparer"): .AddRange x
            ReDim a(1 To UBound(a, 1), 1 To UBound(a, 2)): t = 1
            For Each e In .ToArray
                n = n + 1
                If n > UBound(a, 1) Then n = 1: t = t + 1
                a(n, t) = e
            Next
        End With
        .Value = a
    End With
End Sub

2) By simple sort algorithm.

Sub test()
    Dim a, i&, ii&
    With [i13:k27]
        a = .Value2
        If Not IsArray(a) Then Exit Sub
        For ii = 1 To UBound(a, 2)
            For i = 1 To UBound(a, 1)
                mySort a, i, ii
            Next
        Next
        .Value = a
    End With
End Sub

Private Sub mySort(a, ByVal x&, ByVal y&)
    Dim i&, ii&, n&, t&, temp, s(1)
    n = x: t = y
    If n = UBound(a) Then t = t + 1
    s(0) = a(x, y)
    If Not IsNumeric(s(0)) Then s(0) = UCase$(s(0))
    If s(0) = "" Then s(0) = "zzzz"
    For ii = t To UBound(a, 2)
        For i = IIf(ii = y, n + 1, 1) To UBound(a, 1)
            s(1) = a(i, ii)
            If Not IsNumeric(s(1)) Then s(1) = UCase$(s(1))
            If s(1) = "" Then s(1) = "zzzz"
            If s(0) > s(1) Then
                temp = a(x, y): a(x, y) = a(i, ii): a(i, ii) = temp
                s(0) = a(x, y)
                If Not IsNumeric(s(0)) Then s(0) = UCase$(s(0))
                If s(0) = "" Then s(0) = "zzzz"
            End If
        Next
    Next
End Sub

 

[PPRx]

Thank you so much for the replies. I really appreciate it. I have tried out each option, but none are auto sorting the data as it's entered in. I am very novice and probably doing something wrong. I'm somewhat familiar with auto sorting rows when data within a range is entered in a specific column using Private Sub Worksheet_Change(ByVal Target As Range), and this has worked great.

 

[Fuji]

You can call it like this

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [i13:k27]) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    test
    Application.EnableEvents = True
End Sub

 

[Eric W]

Try this then. Open a new workbook. On the sheet where you have the I14:K27 range, right click on the sheet tab on the bottom. Select View Code. Paste the following code into the window that opens:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MR As Range, it As Variant, i As Long

    Set MR = Range("I13:K27")
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, MR) Is Nothing Then Exit Sub
    
    With CreateObject("System.Collections.ArrayList")
        For Each it In MR
            If it.Value <> "" Then .Add it.Value
        Next
        .Sort
        Application.EnableEvents = False
        MR.ClearContents
        For i = 0 To .Count - 1
            MR.Offset(i Mod MR.Rows.Count, i \ MR.Rows.Count).Resize(1, 1) = .Item(i)
        Next i
        Application.EnableEvents = True
    End With
            
End Sub

Return to Excel and try putting your values in the I14:K27 range.