Background color of rows group based on value first column cells-CodePudding

basically i'm trying to sort and group by color a bunch of rows with a macro

i've managed to sort the rows but i can't find a way to "group" ,or probably better "to select", the rows by the first cell value so i can change the background color

i dont' think is useful but i put the code so far

Sub Macro2()
'
' Macro2 Macro
'

'
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$G$100"), , xlYes).Name = _
        "Table1"
    Range("Table1[#All]").Select
    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight14"
    ActiveWorkbook.Worksheets("StaffHours (5)").ListObjects("Table1").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("StaffHours (5)").ListObjects("Table1").Sort. _
        SortFields.Add Key:=Range("Table1[[#All],[StaffName]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("StaffHours (5)").ListObjects("Table1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

CodePudding user response：

Here's an example of how you could do it:

Sub ColorRows()
    
    Dim lst As ListObject, c As Range, rw As ListRow, staff, indx As Long
    Dim arrColors, dict As Object, clrIndex As Long
    Set dict = CreateObject("scripting.dictionary")
    
    Set lst = ActiveWorkbook.Worksheets("StaffHours (5)").ListObjects("Table1")
    indx = lst.ListColumns("StaffName").Index 'the position of the Staffname column
    arrColors = Array(vbRed, vbYellow, vbBlue, vbGreen, vbMagenta) 'or whatever you like...
    
    For Each rw In lst.ListRows          'loop over all the list rows
        With rw.Range                    'look at the Range for each row
            staff = .Cells(indx).Value   'get the staff name
            If Not dict.exists(staff) Then 'new name?  Store name and next color
                'find the index into the colors array...
                clrIndex = dict.Count Mod (UBound(arrColors)   1) 'mod loops if more values than colors
                Debug.Print staff, clrIndex
                dict.Add staff, arrColors(clrIndex) 'store the staffname and the color
            End If
            .Interior.Color = dict(staff) 'apply the color
        End With
    Next rw

End Sub