With short VBA Code How to Sort pairs of columns using loop until last empty column (120 total)

[AndyJR]

Hi,

It may sound ridiculous what i'm asking, but i made a macro to sort in descending order the first 2 pairs of column (among 120 sets), But it seems that if i sort 120 sets of columns the macro is going to be huge, and that's why i'm requesting help to see if i can get a VBA or code with decent size.

For example first Pair of columns:
A3 have Store Number B3 Sales for Week1 (Then Next Column C3 Store and Column D3 Sales Week2 and so on..)
I need to sort Based on Week sales and repeat the same task for the next pair of columns until last empty column
_____A_______B___
A1 _Store___Sales_
A2_Numb___Week1_
A3_Store 4__ 2000.00
A4_Store 7__ 1895.00
A5_Store 1__ 1800.00
A6_Store 3__ 1600.00
A7_Store 5__ 1585.00
A8_Store 6__ 1250.00
A9_Store 2__ 1000.00

What I need is to sort in Descending Order Based on Week sales and repeat the same task for the next pair of columns (C3 and D3) until last empty columns (as A3 and B3 example).

This is the Macro that i make Just For Column A and B, as can you observe is big for 2 columns and i don't know yet if the file is going to be slow..

Sub SortSample()'

    Range("A2:B9").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Report").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Report").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "A2:B9"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("report").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter
    
End Sub

Thank you so much!

 

[Takae]

Hope this helps.

Sub SortSample() '
Dim LC As Long, LR As Long, i As Long
Dim wsR As Worksheet
Set wsR = Sheets("report")
With wsR
    LC = .cells(3, Columns.count).End(xlToLeft).column
    For i = 1 To LC Step 2
        LR = .cells(Rows.count, i).End(xlUp).row
        With .Sort
            .SortFields.Clear
            .SortFields.Add Key:=wsR.cells(2, i + 1)
            .SetRange wsR.Range(wsR.cells(2, i), wsR.cells(LR, i + 1))
            .Header = xlYes
            .Orientation = xlTopToBottom
            .Apply
        End With
    Next
End With
End Sub

 

[AndyJR]

Hi Takae,

Thank you for the fast response, and thank for the code..

I have 2 question,

1-. The code is sorting in ascending Order, Which line do i have to change to make sort Descending? (sorry ignorance lol) but i can't see the line Order1:=xlDescending

2-. Which Number do i have to change if, (let say) if i decide to start sorting on column J3 and K3 and not A and B? (I mean Column 10 and 11?)


Thank you so much, appreciate !!

 

[Takae]

Sorry, it lacked your order. Please try again.

For i = 1 To LC Step 2
This 1 means columnA and LC means last column.
If you want to start columnJ, you can change 1 to 10.

Sub SortSample() '
Dim LC As Long, LR As Long, i As Long
Dim wsR As Worksheet
Set wsR = Sheets("report")
With wsR
    LC = .cells(3, Columns.count).End(xlToLeft).column
    For i = 1 To LC Step 2
        LR = .cells(Rows.count, i).End(xlUp).row
        With .Sort
            .SortFields.Clear
            .SortFields.Add _
            Key:=wsR.cells(2, i + 1), _
            Order:=xlDescending
            .SetRange wsR.Range(wsR.cells(2, i), wsR.cells(LR, i + 1))
            .Header = xlYes
            .Orientation = xlTopToBottom
            .Apply
        End With
    Next
End With
End Sub

 

[AndyJR]

Hi Takae,

It solved, Appreciated a lot!

Thank you so much