Using VBA to loop through each column and sort from largest to smallest-CodePudding

I have a dataset comprised of numbers in excel containing 300 rows and 2677 columns, I'm looking to loop through each of the columns and sort them from largest to smallest.

I tried to modify the code below but can't find a way to loop through each of the columns and sort by largest to smallest, can anyone help me please?

    Range("I5").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet3").Sort.SortFields.Add2 Key:=Range("I5:I312" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet3").Sort
        .SetRange Range("I5:I312")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

CodePudding user response：

Sort Columns Descending

It is assumed that the data starts in cell I5 on Sheet3 of the workbook containing this code (ThisWorkbook).

Option Explicit

Sub SortColumnsDescending()
' Needs the 'RefColumn' function.
    Const ProcTitle As String = "Sort Columns Descending"
    
    Const wsName As String = "Sheet3"
    Const FirstCellAddress As String = "I5"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim fCell As Range: Set fCell = ws.Range(FirstCellAddress)
    Dim lCell As Range
    Set lCell = ws.Cells(fCell.Row, ws.Columns.Count).End(xlToLeft)
    If lCell.Column < fCell.Column Then Exit Sub ' no data in header row range
    
    Dim hrrg As Range: Set hrrg = ws.Range(fCell, lCell) ' Header Row Range
    Dim frrg As Range: Set frrg = hrrg.Offset(1) ' Data First Row Range
    
    Application.ScreenUpdating = False
    
    Dim crg As Range ' Current Column Range
    Dim frCell As Range ' Current First Row Cell
    
    For Each frCell In frrg.Cells
        Set crg = RefColumn(frCell)
        If Not crg Is Nothing Then
            crg.Sort Key1:=crg, Order1:=xlDescending, Header:=xlNo
            Set crg = Nothing
        'Else ' no data in column range
        End If
    Next frCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Columns sorted.", vbInformation, ProcTitle
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the one-column range from the first cell
'               of a range ('FirstCell') to the bottom-most non-empty cell
'               of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
    ByVal FirstCell As Range) _
As Range
    If FirstCell Is Nothing Then Exit Function
    
    With FirstCell.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row   1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set RefColumn = .Resize(lCell.Row - .Row   1)
    End With

End Function

CodePudding user response：

Please, try the next code. No need to select anything, selection only consumes Excel resources, not bringing any benefit:

Sub SortColumns()
 Dim sh As Worksheet, lastCol As Long, i As Long
 Set sh = Worksheets("Sheet3")
 lastCol = 2677 'it can be calculated, if all existing columns should be sorted
 With Application 'a little optimization
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
 End With
 For i = 1 To lastCol
    sh.Range(sh.cells(5, i), sh.cells(5, i).End(xlDown)).Sort key1:=sh.cells(5, i), _
                  order1:=xlDescending, Header:=xlGuess, Orientation:=xlSortColumns
 Next i
 With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
 End With
End Sub

The above code assumes that no empty cells exists in the sorted ranges. If they may exist, the last row of the range to be sorted should be calculated in a different way. I kept your way of calculating, but without selection...