MultiLevel Sort till end column

**wilsonwilson4** · 12-10-2021, 11:35 AM

Hi,

I am having difficulty on the macro to do multilevel sort by color.

Criteria
- Sort each column that have highlighted till end column (this can be about 40 columns and 500 rows data)
- Ignore the column that no highlighted cell
- Keep the information align when sort across column and row

Below is the VB that tried to develop but seems not working as expected. Attached is sample data Before and After in sheet1. I have done manual by custom sort.

Sub MultiSort)
    Dim xRg As Range 'Declare range for Columns
    Dim yRg As Range 'Declare range for Rows
    Dim ws As Worksheet 'Name the WorkSheet
    Set ws = ActiveSheet
    On Error Resume Next
    Set xRg = Application.InputBox(Prompt:="Range Selection:", _
                                    Title:="Sort Multiple Columns", Type:=8)
    Application.ScreenUpdating = False
    For Each yRg In xRg
        With ws.Sort
            .SortFields.Clear
            .SortFields.Add(Key:=yRg, Order:=xlAscending, _
             SortOn:=xlSortOnCellColor).SortOnValue.Color = vbGreen
            .SetRange ws.Range(yRg, yRg.End(xlDown))
            .Header = xlNo
            .MatchCase = False
            .Apply
        End With
    Next yRg
    Application.ScreenUpdating = True
End Sub

**davesexcel** · 12-11-2021, 11:27 AM

If you want the expect results, you would need to set all the fields at the same time.

Here is a sample using the macro recorder on your sample workbook.
Run the code on your sample.

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("a1:a46"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255 _
        , 0)
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("b1:b46"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255 _
        , 0)
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("c1:c46"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255 _
        , 0)
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("d1:d46"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255 _
        , 0)
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("g1:g46"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255 _
        , 0)
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("h1:h46"), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255 _
        , 0)
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:H46")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

MultiLevel Sort till end column

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

MultiLevel Sort till end column

Re: MultiLevel Sort till end column

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Sort columns B,C,D based on column B then loop to next 3 columns and repeat till last colu

Sort alphabetic with VBA on Range till last row

Sum till the column till the date match

Copy entire selected column to next columns till last column

[SOLVED] sort till last row

[SOLVED] Identify the last filled row in Column A and then drag formula in Column B till the same

[SOLVED] SUM values in a column till you reach a flag in another column- Urgent

Bookmarks

Bookmarks

Posting Permissions