Excel macro to sort cells in rows by length

Question

A couple years ago, by browsing different forums I made myself a macro that was sorting columns by length, longest to shortest (by number of characters in cells). I was pasting special with transpose to a new sheet to get rows listed as columns. I then pasted the VBS code in the macro 100 times so it could do 100 columns per run.

Today I tried running this macro but it doesn't work at all now :(

This is the VBS code I used (without the 100 pastes):

Sub SortByLength2()
Dim lLoop As Long
Dim lLoop2 As Long
Dim str1 As String
Dim str2 As String
Dim MyArray
Dim lLastRow As Long

lLastRow = Range("A65536").End(xlUp).Row
MyArray = Range(Cells(2, 1), Cells(lLastRow, 1))
 'Sort array
For lLoop = 1 To UBound(MyArray)
    For lLoop2 = lLoop To UBound(MyArray)
        If Len(MyArray(lLoop2, 1)) > Len(MyArray(lLoop, 1)) Then
            str1 = MyArray(lLoop, 1)
            str2 = MyArray(lLoop2, 1)
            MyArray(lLoop, 1) = str2
            MyArray(lLoop2, 1) = str1
        End If
    Next lLoop2
Next lLoop
 'Output sorted array
Range("JO1:JO" & UBound(MyArray) + 1) = (MyArray)
    Range("A:A").Delete Shift:=xlToLeft
End Sub

There should be a better solution to sort in rows, without transposing rows to columns and without pasting the same VBS code 100 times...

Could anyone help me with the macro that could simply sort cells in rows by length of characters in each cell with unlimited rows and columns? Longest cells should be 1st, shortest - last

In my case, I have 745 rows and column range from A to BA.

Thanks in advance

Update, as per request, a screnshot: enter image description here

You say that you take data from 1 sheet and paste it into another? You don't specifically reference any sheet so is it possible you are taking the data from the wrong place? — Sam, Nov 03 '13 at 15:14
Not likely that I am using wrong sheet, as there is just one sheet in a file. But anyways the method I was using is super ugly and I simply hate using it, so anyways it might be a good time for a VBS that would do it easy and right — CamSpy, Nov 03 '13 at 15:38
can you post a screenprint of a subset of your source data and another with your required format after the sorting process? — Sam, Nov 03 '13 at 15:44
And you want each column sorted small to large with no respect to adjacent columns? — Doug Glancy, Nov 03 '13 at 15:55
@DougGlancy - I want them large to small, columns doesn't matter — CamSpy, Nov 03 '13 at 16:11
You should be able to use a "custom order" sort. Look [here](http://stackoverflow.com/questions/6100944/code-an-excel-vba-sort-with-a-custom-order-and-a-value-containing-commas) or [here]:(http://social.msdn.microsoft.com/forums/en-US/8a23d8de-4ffb-4d8a-9085-cb21fa43253d/problem-sorting-data-in-excel-customorder-parameter) — paulsm4, Nov 03 '13 at 16:47

Doug Glancy · Accepted Answer · 2013-11-03T17:28:04.960

This is slow. It takes a few seconds for 785 rows, and I'm not sure why. It works though. It copies each row to a new sheet, adds a LEN formula to that sheet and sorts on the formula. It then copies the row back to the original sheet:

Sub SortAllCols()
Dim wsToSort As Excel.Worksheet
Dim wbTemp As Excel.Workbook
Dim wsTemp As Excel.Worksheet
Dim row As Excel.Range
Dim Lastrow As Long

    Set wsToSort = ActiveSheet 'Change to suit
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets(1)
    Application.ScreenUpdating = False

    With wsToSort
        Lastrow = .Range("A" & .Rows.Count).End(xlUp).row
        For Each row In .Range("A1:A" & Lastrow)
            wsTemp.UsedRange.EntireRow.Delete
            row.EntireRow.Copy Destination:=wsTemp.Range("A1")
            wsTemp.UsedRange.Offset(1, 0).FormulaR1C1 = "=LEN(R[-1]C)"
            wsTemp.UsedRange.EntireRow.Sort Key1:=wsTemp.UsedRange.Rows(2), order1:=xlDescending, Orientation:=xlSortRows
            wsTemp.Rows(1).Copy Destination:=row
        Next row
    End With
    Application.ScreenUpdating = True
    wbTemp.Close False
    End Sub

Thanks a lot! It is exactly what I need and the time it does that is much quicker than when I was doing that the other ways. — CamSpy, Nov 03 '13 at 18:30
You should probably set `Application.Calculation` to manual as well, that should improve the speed... — Sam, Nov 03 '13 at 19:26

score 1 · Answer 2 · answered Nov 04 '13 at 17:56

That's a very clever routine Doug. Just for my own amusement I experimented with speeding it up somewhat. Using an array to transfer data instead of directly copying from range to range seems to do it. Was able to reduce sort time (800 rows by 20 columns) from 35 secs to under 2 secs. So if anyone is interested, here's your routine, with my modifications.

Sub SortAllCols()
    Dim wsToSort As Excel.Worksheet
    Dim wbTemp As Excel.Workbook
    Dim wsTemp As Excel.Worksheet
    Dim rRow As Excel.Range
    Dim Lastrow As Long
    Dim rT As Range, v

    Set wsToSort = ActiveSheet 'Change to suit
    Set wbTemp = Workbooks.Add
    Set wsTemp = wbTemp.Worksheets(1)
    Application.ScreenUpdating = False

    With wsToSort
        Lastrow = .Range("A" & .Rows.Count).End(xlUp).row
        For Each rRow In .Range("A1:A" & Lastrow)
            wsTemp.UsedRange.Clear
            v = .Range(rRow, .Cells(rRow.row, .Columns.Count).End(xlToLeft)).Value
            If IsArray(v) Then 'ignore single cell range
                Set rT = wsTemp.Range("A1").Resize(, UBound(v, 2))
                rT.Value = v
                rT.Offset(1, 0).FormulaR1C1 = "=LEN(R[-1]C)"
                rT.Resize(2).Sort Key1:=rT.Rows(2), order1:=xlDescending, Orientation:=xlSortRows
                v = rT.Rows(1).Value
                rRow.Resize(, UBound(v, 2)).Value = v
            End If
        Next rRow
    End With
    Application.ScreenUpdating = True
    wbTemp.Close False
End Sub

Excel macro to sort cells in rows by length

2 Answers2