Форум по VBA, Excel и Word

Прошу помочь написать макрос для форматирования групп ячеек. Названия изделий всегда разные. Спасибо!

Если кому интересно придумал сам через циклы.

Sub ОкраситьШахматку()
'    Цветовое разделение изделий для спецификации покупателя
    Dim z As Long
    Worksheets("СП Покупателю").Activate
   
    Range("B2").Activate
   
    Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 4)).Interior.Color = RGB(226, 239, 218)
    Application.ScreenUpdating = False
    For z = 1 To 100
        Do While ActiveCell = ActiveCell.Offset(1, 0)
                If ActiveCell.Value <> "" Then
                ActiveCell.Offset(1, 0).Activate
                Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 4)).Interior.Color = RGB(226, 239, 218)
                Else: Range(ActiveCell, ActiveCell.Offset(0, 4)).Clear
                Exit For
                End If
        Loop
           ActiveCell.Offset(1, 0).Activate
           Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 4)).Interior.Color = RGB(255, 242, 204)
        Do While ActiveCell = ActiveCell.Offset(1, 0)
                If ActiveCell.Value <> "" Then
                ActiveCell.Offset(1, 0).Activate
                Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 4)).Interior.Color = RGB(255, 242, 204)
                Else: Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 4)).Clear
                Exit For
                End If
        Loop
            ActiveCell.Offset(1, 0).Activate
            Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, 4)).Interior.Color = RGB(226, 239, 218)
   Next
   Application.ScreenUpdating = True
   
    If ThisWorkbook.Worksheets("СП Покупателю").Range("A2") = ThisWorkbook.Worksheets("СП Покупателю").Range("B2") Then
    ThisWorkbook.Worksheets("СП Покупателю").Columns("A").Delete
    End If


End Sub

Нужна кнопка, которая сортирует по цветам?  Или есть другие критерии для сортировки?