Excel VBA

Color Rows by Month

Option Explicit

Sub ColorMonthlys()
    'Begun 10/23/2024 by Alan Barasch
    ' Color each month differently
    Dim Ranger  As String
    Dim LastCol As Long, lastRow As Long, ColorNum As Long
    Dim FirstCol    As Long
    Dim SortRanger As Variant
    Dim C   As Long
    Dim H   As Long
    Dim Quo As String
    Dim MonNm As Variant, RGBnm As Variant 'Arrays
    Quo = Chr(34)   'Quotes character
    Application.ScreenUpdating = True
    Sheets("Schedules").Activate

    ActiveSheet.Unprotect
    lastRow = Range("a99999").End(xlUp).Row
    LastCol = 9   'I    'Last column set in stone; other things past there
    Range(Cells(2, 1), Cells(lastRow, LastCol)).Select
    Selection.Interior.ColorIndex = False   'Remove interior color from all
    Cells(2, 1).Select
    FirstCol = 1

    MonNm = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)         
    RGBnm = Array(RGB(153, 204, 255), _
        RGB(131, 241, 123), _
        RGB(255, 153, 255), _
        RGB(255, 255, 0), _
        RGB(250, 191, 143), _
        RGB(205, 216, 176), _
        RGB(204, 255, 204), RGB(102, 204, 255), _
        RGB(255, 204, 153), RGB(157, 187, 255), _
        RGB(207, 183, 255), RGB(93, 174, 255))    'Array of color schemes
        
        Debug.Print "uColor: " & UBound(RGBnm) & " uMonth: " & UBound(MonNm)
        
        For H = 0 To UBound(MonNm) 'Step thru years
    SortRanger = RGBnm(H)
    For C = 2 To lastRow
        Application.StatusBar = MonNm(H)   'Show Month progress
        If Month(Cells(C, FirstCol)) = MonNm(H) Then
                If C Mod 2 = 0 Then     'Determine if even or odd numbered row
                Sheets("schedules").Range(Cells(C, 1), Cells(C, LastCol)) _
                .Interior.Color = SortRanger    'Year Color
            Else
                Sheets("schedules").Range(Cells(C, 1), Cells(C, LastCol)) _
                .Interior.ColorIndex = False    'No color
                End If
            End If
            Next C
        Next H
        Application.StatusBar = False
        lastRow = Range("B99999").End(xlUp).Row '5/26/23
        Cells(lastRow, 1).Select
        ActiveSheet.Protect
        
    MonNm = 0
    RGBnm = 0
    C = 0
    MsgBox "Updated Schedules Colors", vbInformation, "Done"
        
End Sub