Formatting column in alternating colours, based on text in Row 1

[anarchyflag]

I have a spreadsheet where I need the formatting to change depending on the day of the week. I also want the formatting to alternate colour by line, to help break it up. It should look like this:

I have some code which formats specific ranges of columns to format in the alternating colours:

'Colour Sundays alternate light grey / dark grey
For Each cell In Range("AX1:AX" & lastRow)
    If cell.Row Mod 2 = 1 Then
        cell.Interior.Color = RGB(217, 217, 217)
    Else
        cell.Interior.Color = RGB(242, 242, 242)
    End If
Next cell

However, this isn't particularly agile, since I want to be able to run this report over any number of weeks (up to a year), and hard coding specific cell ranges would mean repeating the same code 52 times.

I also have the following code which I've used for cell widths:

Dim Range1 As Range

Dim Cell1 As Range

Set Range1 = Range("O1:QA1")

    For Each Cell1 In Range1
    If Cell1 Like "*Mon*" Or Cell1 Like "*Tue*" Then
    Cell1.ColumnWidth = 7.86

End If
Next Cell1

    For Each Cell1 In Range1
    If Cell1 Like "*Wed*" Or Cell1 Like "*Thu*" Then
    Cell1.ColumnWidth = 7.86

End If
Next Cell1

    For Each Cell1 In Range1
    If Cell1 Like "*Fri*" Or Cell1 Like "*Sat*" Then
    Cell1.ColumnWidth = 7.86

End If
Next Cell1

Which I'm using for coding the column widths (this isn't great either - I can't work out how to make it count all the weekdays in the same section of code, but it works so I'm happy to leave it).

Is there any way to combine this code so that it reads: If the cell in Row 1 contains Mon, Tue, Wed, Thu, Fri, Sat, change column width and format in alternating colours? And the same for Sundays etc.

Thanks in advance.

 

[LazyBug]

Hello!
For the first point try:

Option Explicit

Sub SunLight()
Dim hr As Long, hlc As Long, hc As Range, lr As Long, c As Range, i As Long

hr = 1                                                  'headers row with name of day
hlc = Cells(hr, Columns.Count).End(xlToLeft).Column     
lr = Cells(Rows.Count, 1).End(xlUp).Row                 

For Each hc In Range(Cells(hr, 1), Cells(hr, hlc))
    If hc.Value Like "*Sun*" Then
        For Each c In Range(Cells(hr, hc.Column), Cells(lr, hc.Column))
            If c.Row Mod 2 = 1 Then
                c.Interior.Color = RGB(217, 217, 217)
            Else
                c.Interior.Color = RGB(242, 242, 242)
            End If
        Next
    End If
Next hc

End Sub

Infortunately I misunderstood your second goal (It could probably be done with VBA If...Then...ElseIf multiple conditions).

 

[anarchyflag]

Hello!
For the first point try:

Option Explicit

Sub SunLight()
Dim hr As Long, hlc As Long, hc As Range, lr As Long, c As Range, i As Long

hr = 1                                                  'headers row with name of day
hlc = Cells(hr, Columns.Count).End(xlToLeft).Column    
lr = Cells(Rows.Count, 1).End(xlUp).Row                

For Each hc In Range(Cells(hr, 1), Cells(hr, hlc))
    If hc.Value Like "*Sun*" Then
        For Each c In Range(Cells(hr, hc.Column), Cells(lr, hc.Column))
            If c.Row Mod 2 = 1 Then
                c.Interior.Color = RGB(217, 217, 217)
            Else
                c.Interior.Color = RGB(242, 242, 242)
            End If
        Next
    End If
Next hc

End Sub

Infortunately I misunderstood your second goal (It could probably be done with VBA If...Then...ElseIf multiple conditions).

Hi - This is fantastic! Thank you. I had managed to work out how to do the column widths, but this one still eluded me.

It's perfect. Thank you so much.

 

[LazyBug]

You're welcome. Thanks for the feedback.