Long range calendar with changing color based on user selection

[jrholden]

I would like help with creating a long range calendar where columns E:NF change color based on the "section" selected by the user. Each section should be its own color. The conditional formatting currently is only gray based on the date range. I would like it to still function the same but just be a different color for each section. I am trying to avoid using the conditional format function because there are many more "sections" than in my example and the names change making maintenance of the conditional format formulas a nightmare. Thank you.

[Mumps1]

Copy and paste this macro into the "2014" worksheet code module. Do the following: right click the tab for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Change either the start date or end date and exit the cell.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bottomC As Integer
    bottomC = Sheets("2014").Range("C" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("C6:D" & bottomC)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lCol As Long
    lCol = Cells(5, Columns.Count).End(xlToLeft).Column
    Dim bottomA As Long
    bottomA = Sheets("Color Codes").Range("A" & Rows.Count).End(xlUp).Row
    Dim section As Range
    If Target.Column = 3 Then
        For Each section In Sheets("Color Codes").Range("A1:A" & bottomA)
            If Target.Offset(0, -2) = section Then
                ActiveSheet.Rows(Target.Row).Interior.ColorIndex = xlNone
                For Each rng1 In Range(Cells(5, 5), Cells(5, lCol))
                    If rng1 = Target Then
                        For Each rng2 In Range(Cells(5, "E"), Cells(5, lCol))
                            If rng2 = Target.Offset(0, 1) Then
                                Range(Cells(Target.Row, rng1.Column), Cells(Target.Row, rng2.Column)).Interior.ColorIndex = section.Offset(0, 1).Interior.ColorIndex
                            End If
                        Next rng2
                    End If
                Next rng1
            End If
        Next section
    End If
    
    If Target.Column = 4 Then
        For Each section In Sheets("Color Codes").Range("A1:A" & bottomA)
            If Target.Offset(0, -3) = section Then
                ActiveSheet.Rows(Target.Row).Interior.ColorIndex = xlNone
                For Each rng1 In Range(Cells(5, 5), Cells(5, lCol))
                    If rng1 = Target Then
                        For Each rng2 In Range(Cells(5, "E"), Cells(5, lCol))
                            If rng2 = Target.Offset(0, -1) Then
                                Range(Cells(Target.Row, rng1.Column), Cells(Target.Row, rng2.Column)).Interior.ColorIndex = section.Offset(0, 1).Interior.ColorIndex
                            End If
                        Next rng2
                    End If
                Next rng1
            End If
        Next section
    End If
    Application.ScreenUpdating = True
End Sub

[Mumps1]

My apologies. After I re-read you post, I realized you wanted the color change to take place when the section in column A was changed. Please use this macro to do that.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bottomA1 As Integer
    bottomA1 = Sheets("2014").Range("A" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("A6:A" & bottomA1)) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lCol As Long
    lCol = Cells(5, Columns.Count).End(xlToLeft).Column
    Dim bottomA As Long
    bottomA = Sheets("Color Codes").Range("A" & Rows.Count).End(xlUp).Row
    Dim section As Range
    For Each section In Sheets("Color Codes").Range("A1:A" & bottomA)
        If Target = section Then
            ActiveSheet.Rows(Target.Row).Interior.ColorIndex = xlNone
            For Each rng1 In Range(Cells(5, 5), Cells(5, lCol))
                If rng1 = Target.Offset(0, 2) Then
                    For Each rng2 In Range(Cells(5, "E"), Cells(5, lCol))
                        If rng2 = Target.Offset(0, 3) Then
                            Range(Cells(Target.Row, rng1.Column), Cells(Target.Row, rng2.Column)).Interior.ColorIndex = section.Offset(0, 1).Interior.ColorIndex
                        End If
                    Next rng2
                End If
            Next rng1
        End If
    Next section
    Application.ScreenUpdating = True
End Sub

The previous macro does the color change when either the start or end date is changed. Well now you have two options for doing the same thing.

[jrholden]

Thank you Mumps1 for your response. Sorry, I cannot get the code to work. All it seems to do is remove the background color from the rows and add a light gray border. It is not changing the fill color to the corresponding color on the "Color Codes" tab based on the section chosen in column A. Please help!!

[Mumps1]

Try the attached file. It is working for me.

[jrholden]

I don't understand, it doesn't work for me either. The macros are enabled but the cells are not being filled by color.

[Mumps1]

I don't know what to tell you. The file I attached works perfectly for me. It changes the color according to the Color Codes sheet. Maybe you could start a new thread on the forum, attach the file and explain the problem. I'm at a loss right now.