Sort Excel worksheet with multiple colors

[lostyankee]

I have a spreadsheet that I need to sort that has multiple colors, sorting:
Blue
Red
Orange
Yellow

After this I have code to remove duplicates in the data, but I need to retain these in priority order, hence the need for sorting. Any ideas?

Sub SortByColor()

    ActiveWorkbook.Worksheets("IYD All").Sort.SortFields.Clear
    ' Sort column B by Blue Priority
    ActiveWorkbook.Worksheets("IYD All").Sort.SortFields.Add(Range("b2"), _
        xlSortOnCellColor, xlAscending, , _
        xlSortNormal).SortOnValue.Color = RGB(0, 204, 255)
    ' Sort Column B by Red Priority
    ActiveWorkbook.Worksheets("IYD All").Sort.SortFields.Add(Range("b2"), _
        xlSortOnCellColor, xlAscending, , _
        xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
    ' Sort column B by Orange Priority
    ActiveWorkbook.Worksheets("IYD All").Sort.SortFields.Add(Range("b2"), _
        xlSortOnCellColor, xlAscending, , _
        xlSortNormal).SortOnValue.Color = RGB(255, 120, 0)
    ' Sort column B by Yellow Priority
    ActiveWorkbook.Worksheets("IYD All").Sort.SortFields.Add(Range("b2"), _
        xlSortOnCellColor, xlAscending, , _
        xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
  

End Sub

 

[kevin9999]

Please try the following on a copy of your workbook:

Option Explicit
Sub Sort_Color()
    Dim ws As Worksheet, r As Range
    Set ws = Worksheets("IYD All")
    Set r = ws.Range("A1").CurrentRegion
    
    With ws.Sort
        With .SortFields
            .Clear
            .Add(ws.Range("B2"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 204, 255)
            .Add(ws.Range("B2"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
            .Add(ws.Range("B2"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 120, 0)
            .Add(ws.Range("B2"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 255, 0)
        End With
        .SetRange r
        .Header = xlYes
        .Orientation = xlTopToBottom
        .Apply
    End With
    
End Sub