2

I have a large excel file which I am trying to sort left-to-right by row, been trying to get a vba approach to work, but my experience is too low. Surprising how hard it is to do what should be a simple task.

I have tried this code from another post but is mixing them and only 1st row gets arranged.

Sub sortfile22()
   Dim keyrange As String
    Dim DataRange As String

    keyrange = "A1:T1"
    DataRange = "A1:T8"

    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(keyrange), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(DataRange)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

My data looks something like this

1   2   3   4   5   6   7   8   9   10  11  12  13  14  15  16  17  18  19  20    
48  1   16  40  75  21  50  3   35  73  80  53  33  46  38  2   69  54  63  79    
54  27  62  56  79  67  71  75  28  35  78  66  60  65  5   47  31  38  68  21    
56  77  43  9   64  80  72  16  17  46  10  22  63  34  41  8   53  60  6   79
T.M.
  • 9,436
  • 3
  • 33
  • 57
  • 1
    You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). – Pᴇʜ May 09 '19 at 14:34

3 Answers3

3

You need to sort each row on its own. Therefore loop row wise through the DataRange and sort each DataRow on its own.

Option Explicit

Public Sub SortRowWise()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim DataRange As Range
    Set DataRange = ws.Range("A1").CurrentRegion

    Dim DataRow As Range
    For Each DataRow In DataRange.Rows 'loop through all rows of the data
        With ws.Sort
            .SortFields.Clear
            .SortFields.Add Key:=DataRow, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Rng:=DataRow
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
    Next DataRow
End Sub

So this input data …

enter image description here

… will sort as:

enter image description here

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
1

Was actually a bit harder than I expected, but here's the code:

I also borrowed, the standard algorithm, courtesy of wellsr.com, but feel free to use any other sorting algorithm you want, just make sure you change this line of code:

Quicksort sortrow, LBound(sortrow), UBound(sortrow) ' calling QuickSort

Then the code is executed the following way:

Private Sub main()
    
    Dim i As Integer, lc As Long, lr as Long, j As Integer
    Dim arr As Variant
    

    lr = Cells(Rows.Count, 1).End(xlUp).Row ' finds the last row
    lc = Cells(1, Columns.Count).End(xlToLeft).Column ' finds the last i-th column
    arr = Range(Cells(1, 1), Cells(lr, lc)).Value2
             
    Dim sortrow() As Integer ' sorting each row separately
    
    For i = LBound(arr, 1) To UBound(arr, 1) ' for every row
        For j = LBound(arr, 2) To UBound(arr, 2) ' add
            ReDim Preserve sortrow(1 To j)
            sortrow(j) = arr(i, j) ' adding arr elements to SortRow
        Next j
        
        Quicksort sortrow, LBound(sortrow), UBound(sortrow) ' calling QuickSort
        For j = LBound(sortrow) To UBound(sortrow)
            Cells(i, j) = sortrow(j) ' print the sorted results
        Next j
    Next i
End Sub

Works as expected:

enter image description here

Community
  • 1
  • 1
Samuel Hulla
  • 6,617
  • 7
  • 36
  • 70
  • Actually the built in sort algorithm can sort left to right `.Orientation = xlLeftToRight` and should be faster because it can use multi-threading while VBA cannot. Actually because of that built in functions should always be faster than self written VBA code. • And you should change to `Long` Excel has more rows than `Integer` can handle. – Pᴇʜ May 09 '19 at 14:52
  • 1
    I'm not arguing efficiency here, just an alternative option. Took me quite some time to get it right so might as well post it. As to the `Long`, yeah you are right, though I doubt OP will exceed `Integer` range given his data sats, but for sake of correctness I have edited it – Samuel Hulla May 09 '19 at 14:57
  • You could *recode* the loop after `QuickSort` as simple one liner: `Cells(i, 1).Resize(1, UBound(sortrow)) = sortrow`. *BTW suggest to fully qualify range references* :-) @Rawrplus ` – T.M. May 09 '19 at 15:29
  • Additional hint: furthermore you could even replace the `sortrow` declaration once by `ReDim sortrow(1 To lc) As Integer` avoiding permanent redimming. – T.M. May 09 '19 at 15:42
  • 1
    @T.M. thanks for the input, I'll look into it tomorrow. – Samuel Hulla May 09 '19 at 21:38
0

Slightly modified array approach

Just for the sake of the art I modified @Rawrplus' valid & fast solution by reducing three loops to one and by avoiding permanent redimming.

Option Explicit                                             ' declaration head of code module

Private Sub Main()
With Sheet1                                                 ' << reference sheet via code name, e.g. Sheet1
  ' [1] do some statistics over data range
    Dim i&, lr&, lc&                                        ' declare datatype Long
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row               ' find last row
    lc = .Cells(1, .Columns.Count).End(xlToLeft).Column     ' find last column
  ' [2] assign data to array
    Dim arr(), sortrow()                                    ' declare Variant arrays
    arr = .Range(.Cells(1, 1), .Cells(lr, lc)).Value2       ' assign range data to 1-based 2-dim datafield array
  ' [3] sort row data and write them back to sheet
    For i = LBound(arr, 1) To UBound(arr, 1)                ' loop through row data
        sortrow = Application.Index(arr, i, 0)              ' assign current row data to 1-dim sortrow array
        Quicksort sortrow, LBound(sortrow), UBound(sortrow) ' calling QuickSort
        .Cells(i, 1).Resize(1, UBound(sortrow)) = sortrow   ' write sorted row data back to sheet
    Next i
End With
End Sub

T.M.
  • 9,436
  • 3
  • 33
  • 57