Last column sorting for multiple fixed rows through VBA-CodePudding

trying to fix the macro for sorting on the last column of every sheet but the rows are fixed A3:A20 & A23:A32. Found the below code but I am unable to lock rows in it. unable to crack how to define the rows in the below code. sample data

Sub jusho()    
    Dim lColumn As Long
    lColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    Range(Cells(2, 1), Cells(LastRow, lColumn)).Sort key1:=Range(Cells(2, lColumn), Cells(LastRow, lColumn)), _
       order1:=xlAscending, Header:=xlNo
End Sub

CodePudding user response：

Sort Multiple Ranges

Option Explicit

Sub SortByLastColumnASC()
    SortMultipleRanges ThisWorkbook, "Sheet1", "2:20,22:32"
End Sub

Sub SortByLastColumnDSC()
    SortMultipleRanges ThisWorkbook, "Sheet1", "2:20,22:32", , xlDescending
End Sub

Sub SortBySalesKeyASC()
    SortMultipleRanges ThisWorkbook, "Sheet1", "2:20,22:32", 1
End Sub

Sub SortByDateKeyASC()
    SortMultipleRanges ThisWorkbook, "Sheet1", "2:20,22:32", 2
End Sub

Sub SortMultipleRanges( _
        ByVal wb As Workbook, _
        ByVal wsName As String, _
        ByVal wsRowsList As String, _
        Optional ByVal SortColumn As Long = 0, _
        Optional ByVal SortOrder As XlSortOrder = xlAscending, _
        Optional ByVal SortHeader As XlYesNoGuess = xlYes)
    Const ProcName As String = "SortMultipleRanges"
    On Error GoTo ClearError

    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
    
    If SortColumn = 0 Then
        SortColumn = srg.Columns.Count
    End If
    
    Dim wsRows() As String: wsRows = Split(wsRowsList, ",")
    Dim nUpper As Long: nUpper = UBound(wsRows)
    
    Dim drg As Range
    Dim n As Long
    
    For n = 0 To nUpper
        Set drg = srg.Rows(wsRows(n))
        drg.Sort Key1:=drg.Columns(SortColumn), Order1:=SortOrder, _
            Header:=SortHeader
    Next n
    
ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Sub

CodePudding user response：

Consider using the macro to find the start row and end row of the sort ranges rather than hard coding them in.

Option Explicit
Sub SortRows()

    Dim wb As Workbook, ws As Worksheet
    Dim LastCol As Long, LastRow As Long, r As Long, n As Long
    Dim rowStart As Long, rng As Range, s As String

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    With ws
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        For r = 2 To LastRow
          ' start sort range
           If .Cells(r, "A") = "SalesKey" Then
               If rowStart > 0 Then
                   MsgBox "Duplicate SalesKey on row " & r, vbExclamation
               End If
               rowStart = r   1
           ' end sort range
           ElseIf .Cells(r, "A") = "Total" Then
                If rowStart = 0 Then
                    MsgBox "Total without records on row " & r, vbExclamation
                ElseIf r > rowStart   1 Then
                    Set rng = .Cells(rowStart, 1).Resize(r - rowStart, LastCol)
                    rng.Sort key1:=.Cells(r, LastCol),  _
                             order1:=xlAscending, Header:=xlNo
                    s = s & vbCrLf & rng.Address
                End If
                rowStart = 0
           End If
        Next
    End With
    MsgBox "Sorted ranges : " & s, vbInformation
End Sub