Excel 2013: sorting columns based on the first value line using VBA

advertisements

I would like to implement an Excel macro that sorts all columns from column "C" to the last column containing data (columns A and B shall not be affected).

The columns shall be sorted from A->Z based on the cell value of their first row (which is a string).

So far, I came up with the following code which I do not like that much because it contains hardcoded numbers for the Sort range making the code not really robust.

Sub SortAllColumns()
    Application.ScreenUpdating = False

'Sort columns
    With ActiveWorkbook.Worksheets("mySheet").Sort
        .SetRange Range("C1:ZZ1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .Apply
    End With

    Application.ScreenUpdating = True
End Sub

Searching the internet, one may find tons of suggestions getting the last used column or row. However most of them will blow up the code more than I expected.

I am not a VBA expert and it would be great if someone could make a suggestion how this problem can be solved in an elegant and efficient way.

If this is important: We will definitely not have more that 1000 rows and 1000 columns.

Any suggestion is highly appreciated.


edited:

  • changed temporary sheet adding statement to have it always as the last one
  • revised its deletion statement accordingly

should your need be to sort columns by moving them so as to have their headers sorted from left to right, then try this code

Option Explicit

Sub main()
Dim lastCol As Long

With Sheets("mySheet")
    lastCol = .cells(1, .Columns.Count).End(xlToLeft).Column
    Call OrderColumns(Range(.Columns(3), Columns(lastCol)))
End With

End Sub

Sub OrderColumns(columnsRng As Range)
Dim LastRow As Long

With columnsRng
    LastRow = GetColumnsLastRow(columnsRng)
    With .Resize(LastRow)
        .Copy

        With Worksheets.Add(after:=Worksheets(Worksheets.Count)).cells(1, 1).Resize(.Columns.Count, .Rows.Count) 'this will add a "helper" sheet: it'll be removed
            .PasteSpecial Paste:=xlPasteAll, Transpose:=True
            .Sort key1:=.Columns(1), Order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlNo
            .Copy
        End With
        .PasteSpecial Paste:=xlPasteAll, Transpose:=True

        Application.DisplayAlerts = False: Worksheets(Worksheets.Count).Delete: Application.DisplayAlerts = True 'remove the "helper" sheet (it's the (n-1)th sheet)

    End With

End With

End Sub

Function GetColumnsLastRow(rng As Range) As Long
Dim i As Long
'gets last row of the given columns range

GetColumnsLastRow = -1
With rng
    For i = 1 To .Columns.Count
        GetColumnsLastRow = WorksheetFunction.Max(GetColumnsLastRow, .Parent.cells(.Parent.Rows.Count, .Columns(i).Column).End(xlUp).row)
    Next i
End With
End Function

it makes use of a "helper" temporary (it gets deleted by the end) sheet.