Sort multiple rows horizontally and independently.

[JohnZ1156]

I have a table of numbers with many rows. (1918 rows)
Column A has a date, numbers are from columns B:F

If cell A2 has a date, I would like to sort B2:F2 independently.
Then look down into the next row.
If cell A3 has a date, I would like to sort B3:F3 independently.
And so on until the macro doesn't see a date in column A.

I recorded a Macro which will only do one row at a time.

Sub Macro1()
'
' Macro1 Macro
'
    Range("B2:F2").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("B2:F2") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B2:F2")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[Skyybot]

Try this on a copy of your Workbook as unexpected results may occur

Sub Macro1()
'
' Macro1 Macro
'
Dim cell As Range

For Each cell In Range("A1:A" & Worksheets("Sheet1").Rows.Count)
If IsDate(cell.Value) Then
    Range("B" & cell.Row & ":F" & cell.Row).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("B" & cell.Row & ":F" & cell.Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B" & cell.Row & ":F" & cell.Row)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End If
Next cell
End Sub

 

[Skyybot]

Edit

Sub Macro1()
'
' Macro1 Macro
'
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("A1:A" & Worksheets("Sheet1").Rows.Count)
If IsDate(cell.Value) Then
    Range("B" & cell.Row & ":F" & cell.Row).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("B" & cell.Row & ":F" & cell.Row) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B" & cell.Row & ":F" & cell.Row)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End If
Next cell
Application.ScreenUpdating = True
End Sub

 

[kevin9999]

Similar approach to @Skyybot , tested at 2K rows at around 0.5 seconds.

Option Explicit
Sub L_to_R()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, c As Range
    Set ws = Worksheets("Sheet1")
    For Each c In ws.Range("A2", Cells(Rows.Count, "A").End(xlUp))
        If IsDate(c) Then c.Offset(, 1).Resize(, 5).Sort _
        Key1:=c, Order1:=xlAscending, Orientation:=xlLeftToRight
        ws.Sort.SortFields.Clear
    Next c
    Application.ScreenUpdating = True
End Sub

 

[JohnZ1156]

Hi Kevin9999,

Thank you, it worked great !!!

 

[kevin9999]

Glad we helped, and thanks for the feedback