none
Sort coulmns by colors independently. RRS feed

  • Question

  • Hello, 

    I want to sort all columns in excel sheet (range may be all excel columns) dynamically using VBA. The requirements are:

    Independent sorting of columns and by colors: Green, then Yellow, then orange then Blue then blanks (empty cells) 

    Here is a copy of the file. Can this be achived.

    Thanks

    Sunday, July 19, 2015 4:33 PM

Answers

  • Try it like this - assuming the cells are filled with values. If you just have colors, you need to change

    Cells(2, Columns.Count).End(xlToLeft).Column

    to

    ActiveSheet.UsedRange.Columns.Count

    Sub SortColumnsOnColors()
        
        Dim r As Range
        Dim c As Long
        
        For c = 1 To Cells(2, Columns.Count).End(xlToLeft).Column
            With ActiveSheet
                .Sort.SortFields.Clear
                .Sort.SortFields.Add(.Cells(2, c), _
                xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 176 _
                , 80)
                .Sort.SortFields.Add(.Cells(2, c), _
                xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
                255, 0)
                .Sort.SortFields.Add(.Cells(2, c), _
                xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
                192, 0)
                .Sort.SortFields.Add(.Cells(2, c), _
                xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 176 _
                , 240)
                With .Sort
                    .SetRange ActiveSheet.Columns(c)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .Apply
                End With
            End With
        Next c
    End Sub


    Monday, July 20, 2015 3:39 PM

All replies

  • Try it like this - assuming the cells are filled with values. If you just have colors, you need to change

    Cells(2, Columns.Count).End(xlToLeft).Column

    to

    ActiveSheet.UsedRange.Columns.Count

    Sub SortColumnsOnColors()
        
        Dim r As Range
        Dim c As Long
        
        For c = 1 To Cells(2, Columns.Count).End(xlToLeft).Column
            With ActiveSheet
                .Sort.SortFields.Clear
                .Sort.SortFields.Add(.Cells(2, c), _
                xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 176 _
                , 80)
                .Sort.SortFields.Add(.Cells(2, c), _
                xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
                255, 0)
                .Sort.SortFields.Add(.Cells(2, c), _
                xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
                192, 0)
                .Sort.SortFields.Add(.Cells(2, c), _
                xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 176 _
                , 240)
                With .Sort
                    .SetRange ActiveSheet.Columns(c)
                    .Header = xlYes
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .Apply
                End With
            End With
        Next c
    End Sub


    Monday, July 20, 2015 3:39 PM
  • Thank you so much Bernie,

    It is awesome code, after little modify to end to the right!

    For c = 1 To Cells(2, Columns.Count).End(xlToRight).Column

    If we want to continue sort on text value after the colored cells, who you can achieve this?

    Thanks :)

    Monday, July 20, 2015 4:24 PM
  • No, you really don't want to use xlToRight to go to the right from the last column of the sheet, because Cells(2,Column.Count) is cell XFD2, the last cell of row 2. From there, you go back to the left to find the last filled column. Otherwise, your code is processing 16,384 columns.

     Sub Ooops()

      MsgBox "To the right: " & Cells(2, Columns.Count).End(xlToRight).Column
        MsgBox "To the & Cells(2, Columns.Count).End(xlToLeft).Column

    End Sub


    If you want to go to the right, you would start from column 1

    For c = 1 To Cells(2, 1).End(xlToRight).Column

    But each of these depends on the cells being filled with values and not just filled with colors.

    The advantages of going to the end of the row and moving to the left are that: 1) blanks don't get in the way, so you find the true right-most filled cell  2) you don't have to check if only one cell is filled - the code would take you all the way to the last column in that case


    Monday, July 20, 2015 4:41 PM
  • Thanks Bernie for the clarification. :)

    Tuesday, July 21, 2015 6:38 AM