lilbuggs
lilbuggs

Reputation: 1

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

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

Upvotes: 0

Views: 69

Answers (1)

user4039065
user4039065

Reputation:

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.

Upvotes: 1

Related Questions