Streamline a recorded macro that spans over multiple tabs and sorts on different columns

Question

I have recorded a macro that does a custom sort over eight worksheets and sorts on four columns. I have a workbook with nine total worksheets. The first eight of the worksheets need to be sorted upon opening the workbook. The ninth worksheet is a validation page for Conditional Formatting and error check formulas.

I want VBA that is simpler than a recorded macro produces for the eight worksheets. Each worksheet needs to be sorted by columns B, C, D, and E. All data starts at row 5 but never ends on the same row within the worksheets. I need to sort the entire sheet and not just a range.

Is there VBA that will do this more simply than creating the macro for all eight worksheets?

I'm sure a 'For' loop will probably take care of cycling through the worksheets and xldown will find all the data in each worksheet but I'm really struggling on how to streamline this with the sorts that need to be performed. The VBA from the recorded macro is:

Sub Auto_Open()
Sort_All Macro
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0809 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("0809 Vehicles").Sort
    .SetRange Range("A5:Q217")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("0910 Vehicles ").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "B5:B217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "C5:C217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "D5:D217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("0910 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "E5:E217"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("0910 Vehicles ").Sort
    .SetRange Range("A5:Q217")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("1011 Vehicles ").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "B5:B215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "C5:C215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "D5:D215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("1011 Vehicles ").Sort.SortFields.Add Key:=Range( _
    "E5:E215"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("1011 Vehicles ").Sort
    .SetRange Range("A5:S215")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("11-12 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWindow.SmallScroll Down:=-234
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B237"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C237"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D237"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("11-12 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E237"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("11-12 Vehicles").Sort
    .SetRange Range("A5:R237")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("12-13 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Range("A5:R259").Select
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B259"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C259"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D259"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("12-13 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E259"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("12-13 Vehicles").Sort
    .SetRange Range("A5:R259")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("13-14 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("13-14 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E245"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("13-14 Vehicles").Sort
    .SetRange Range("A5:T245")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("14-15 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B249"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C249"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D249"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("14-15 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E249"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("14-15 Vehicles").Sort
    .SetRange Range("A5:R249")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Sheets("15-16 Vehicles").Select
Range("A5").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Add Key:=Range( _
    "B5:B234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Add Key:=Range( _
    "C5:C234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Add Key:=Range( _
    "D5:D234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
ActiveWorkbook.Worksheets("15-16 Vehicles").Sort.SortFields.Add Key:=Range( _
    "E5:E234"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("15-16 Vehicles").Sort
    .SetRange Range("A5:R234")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
End Sub

you need to do a for each loop on the worksheet, and use one of the sorting and replace "15-16 Vehicles" with ws.name, so for each ws in thisworkbook.worksheets ws.usedrange.sort.sortfields etc..... next ws with an if statement to check its not sheet 9 — Nathan_Sav, Nov 11 '15 at 22:53
Were you aware that some of your worksheet names seem to have trailing spaces? — , Nov 11 '15 at 23:27

score 1 · Answer 1 · edited May 23 '17 at 11:51

The recorded code for sorting is usually more than just a little verbose. Chopping it down to what is actually needed can certainly remove a lot of useless code.

Sub Sort_All_Macro()
    Dim v As Long, wsARR As Variant
    Dim lr As Long

    'make an array of the worksheet names
    'some of the ws names seemed to have trailing spaces; the spaces should be removed
    wsARR = Array("0809 Vehicles", "0910 Vehicles", "1011 Vehicles", "11-12 Vehicles", _
                  "12-13 Vehicles", "13-14 Vehicles", "14-15 Vehicles", "15-16 Vehicles")
    'from the first in the array to the last
    For v = LBound(wsARR) To UBound(wsARR)
        'work on each in turn
        With Worksheets(wsARR(v))
            'get the last row in column Q
            lr = .Cells(Rows.Count, "Q").End(xlUp).Row
            'work on A5 to the last row in Q
            With .Range(.Cells(5, 1), .Cells(lr, "Q"))
                'sort on columns E first (can only sort on max 3 columns at a time this way
                .Cells.Sort Key1:=.Columns(5), Order1:=xlAscending, _
                            Orientation:=xlTopToBottom, Header:=xlYes   '<~~ you should know if there is a header or not
                'sort on columns B, C, D (finish off the sort)
                .Cells.Sort Key1:=.Columns(2), Order1:=xlAscending, _
                            Key2:=.Columns(3), Order2:=xlAscending, _
                            Key3:=.Columns(4), Order3:=xlAscending, _
                            Orientation:=xlTopToBottom, Header:=xlYes   '<~~ you should know if there is a header or not
            End With
        End With
    Next v
End Sub

This method of sorting can only work on three key columns at one (i.e. there is no key4 parameter). The trick is to sort the fourth one first, then sort the first three.

Referencing the each worksheet in turn with a With ... End With statement reduces the amount of repetitious references. A Range becomes a .Range and Cells becomes .Cells to note it belongs to the worksheet referenced by the With ... End With.

See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

Thank you @Jeeped! I was unaware that there were spaces in two of the worksheet names and I have fixed them. Additionally with the data being selected there is no header, so I changed that to xlNo and changed the code from ascending to descending order. — lilbuggs, Nov 12 '15 at 19:22

Streamline a recorded macro that spans over multiple tabs and sorts on different columns

1 Answers1

Linked