Question about creating a macro to sort many rows individually

[David28]

I started the macro below which sorts rows 1-3 individually from smallest to largest. It sorts B1:E1,then B2:E2, and then B3:E3. The code is the same for each row of the worksheet with the exception of three minor changes in the code due to moving to the next row. I need this macro to individually sort hundreds of rows of data. Instead of writing a very long macro in this way for all of the rows of data on the worksheet, is there a way to make the macro loop and individually sort each row until it finishes sorting all the rows of data? I appreciate any help!

Range("B1:E1").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.AddKey:=Range("B1:E1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
WithActiveWorkbook.Worksheets("Sheet1").Sort
.SetRangeRange("B1:E1")
.Header =xlGuess
.MatchCase =False
.Orientation =xlLeftToRight
.SortMethod =xlPinYin
.Apply
End With
Range("B2:E2").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.AddKey:=Range("B2:E2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
WithActiveWorkbook.Worksheets("Sheet1").Sort
.SetRangeRange("B2:E2")
.Header =xlGuess
.MatchCase =False
.Orientation =xlLeftToRight
.SortMethod =xlPinYin
.Apply
End With
Range("B3:E3").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.AddKey:=Range("B3:E3"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
WithActiveWorkbook.Worksheets("Sheet1").Sort
.SetRangeRange("B3:E3")
.Header =xlGuess
.MatchCase =False
.Orientation =xlLeftToRight
.SortMethod =xlPinYin
.Apply
End With
End Sub

 

[vcoolio]

Hello David,

If you are sorting by rows (horizontally) and not by columns, then try the following:-

Sub SortRows()

    Dim Rng As Range
    Dim ws As Worksheet
    
    Set ws = ThisWorkbook.ActiveSheet
    Set Rng = ws.[A1].CurrentRegion
        
Application.ScreenUpdating = False
        
            With ws.Sort
                .SortFields.Clear
                For i = 1 To Rng.Rows.Count
                    .SortFields.Add Key:=ws.Cells(i, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlLeftToRight
                    .SetRange Rng.Rows(i)
                    .Apply
                    .SortFields(1).Delete
                Next i
            End With
        
Application.ScreenUpdating = True
        
End Sub

It should take care of all rows for you.

I hope that this helps.

Cheerio,
vcoolio.

 

[Marcelo Branco]

Welcome to Mr Excel forum

Maybe...

Sub aTest()
    Dim rRow As Range
        
    For Each rRow In Range("B1:E" & Cells(Rows.Count, "B").End(xlUp).Row).Rows
        rRow.Sort key1:=rRow.Cells(1), Orientation:=xlSortRows, order1:=xlAscending, Header:=xlNo
    Next rRow
End Sub

Hope this helps

M.