Change sheet tab color based on day of the week

[SubwaySparky]

Hello all, first time posting here, newbie with VBA. I have an excel workbook with a different sheet for each day in a month. I'd like to make the sheet tabs color go red on Saturdays and Green on Sundays. I found a VBA code to automatically increment the date in cell A2 by 1 on each sheet. When I input the first day of the month in cell A2 on sheet 1, it automatically adds one day to the rest of the sheets in cell A2. How do I get a code to read the day of the week in a date formatted cell A2 and change the tabs accordingly for the entire workbook? I found code for text to make color changes, but not days of the week. Thanks in advance!

 

[Logit]

Here are two macros ... first one creates a tab for each day of the month. Second macro colors the tabs for Saturdays and Sundays.

Option Explicit

Sub DoDays()
    Dim J As Integer
    Dim K As Integer
    Dim sDay As String
    Dim sTemp As String
    Dim iTarget As Integer
    Dim dBasis As Date

    iTarget = 13
    While (iTarget < 1) Or (iTarget > 12)
        iTarget = Val(InputBox("Numeric month?"))
        If iTarget = 0 Then Exit Sub
    Wend

    Application.ScreenUpdating = False
    sTemp = Str(iTarget) & "/1/" & Year(Now())
    dBasis = CDate(sTemp)
    
    For J = 1 To 31
        sDay = Format((dBasis + J - 1), "dddd mm-dd-yyyy")
        If Month(dBasis + J - 1) = iTarget Then

            If J <= Sheets.Count Then
                If Left(Sheets(J).Name, 5) = "Sheet" Then
                    Sheets(J).Name = sDay
                Else
                    Sheets.Add.Move after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = sDay
                End If
            Else
                Sheets.Add.Move after:=Sheets(Sheets.Count)
                ActiveSheet.Name = sDay
            End If
        End If
    Next J

    For J = 1 To (Sheets.Count - 1)
        For K = J + 1 To Sheets.Count
            If Right(Sheets(J).Name, 10) > _
              Right(Sheets(K).Name, 10) Then
                Sheets(K).Move Before:=Sheets(J)
            End If
        Next K
    Next J
    
    colTab

    Application.ScreenUpdating = True
End Sub

Sub colTab()
Dim I As Long
For I = 1 To Sheets.Count

   If Left(Sheets(I).Name, 3) = "Sat" Then
      Sheets(I).Tab.Color = RGB(255, 0, 0)
   End If

   If Left(Sheets(I).Name, 3) = "Sun" Then
      Sheets(I).Tab.Color = RGB(0, 255, 0)
   End If

Next I
End Sub

 

[SubwaySparky]

Here are two macros ... first one creates a tab for each day of the month. Second macro colors the tabs for Saturdays and Sundays.

Option Explicit

Sub DoDays()
    Dim J As Integer
    Dim K As Integer
    Dim sDay As String
    Dim sTemp As String
    Dim iTarget As Integer
    Dim dBasis As Date

    iTarget = 13
    While (iTarget < 1) Or (iTarget > 12)
        iTarget = Val(InputBox("Numeric month?"))
        If iTarget = 0 Then Exit Sub
    Wend

    Application.ScreenUpdating = False
    sTemp = Str(iTarget) & "/1/" & Year(Now())
    dBasis = CDate(sTemp)
   
    For J = 1 To 31
        sDay = Format((dBasis + J - 1), "dddd mm-dd-yyyy")
        If Month(dBasis + J - 1) = iTarget Then

            If J <= Sheets.Count Then
                If Left(Sheets(J).Name, 5) = "Sheet" Then
                    Sheets(J).Name = sDay
                Else
                    Sheets.Add.Move after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = sDay
                End If
            Else
                Sheets.Add.Move after:=Sheets(Sheets.Count)
                ActiveSheet.Name = sDay
            End If
        End If
    Next J

    For J = 1 To (Sheets.Count - 1)
        For K = J + 1 To Sheets.Count
            If Right(Sheets(J).Name, 10) > _
              Right(Sheets(K).Name, 10) Then
                Sheets(K).Move Before:=Sheets(J)
            End If
        Next K
    Next J
   
    colTab

    Application.ScreenUpdating = True
End Sub

Sub colTab()
Dim I As Long
For I = 1 To Sheets.Count

   If Left(Sheets(I).Name, 3) = "Sat" Then
      Sheets(I).Tab.Color = RGB(255, 0, 0)
   End If

   If Left(Sheets(I).Name, 3) = "Sun" Then
      Sheets(I).Tab.Color = RGB(0, 255, 0)
   End If

Next I
End Sub

Thank you for the code but my sheets are just numbered 1-31. Each sheet has the date in cell A2. Without going through the whole workbook, I'm trying to simply get the tab to change color based on the day of the week in cell A2

 

[rpaulson]

try this

Sub Sheet_Color()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    ws.Tab.ColorIndex = xlColorIndexNone 'remove tab color from all sheets
    If WorksheetFunction.Weekday(ws.Range("A2")) = 7 Then ws.Tab.ColorIndex = 3 'set Saturday to red
    If WorksheetFunction.Weekday(ws.Range("A2")) = 1 Then ws.Tab.ColorIndex = 4 'set Sunday to Green
Next ws

End Sub

 

[SubwaySparky]

try this

Sub Sheet_Color()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    ws.Tab.ColorIndex = xlColorIndexNone 'remove tab color from all sheets
    If WorksheetFunction.Weekday(ws.Range("A2")) = 7 Then ws.Tab.ColorIndex = 3 'set Saturday to red
    If WorksheetFunction.Weekday(ws.Range("A2")) = 1 Then ws.Tab.ColorIndex = 4 'set Sunday to Green
Next ws

End Sub

That works! Again, being new to the VBA world, when I change the date on sheet 1 to for example march 1. All the sheets update their dates but the colors don't change until I open the code and hit run. How do I make excel apply the date change?

 

[rpaulson]

right click on the sheet1 tab - Click on view code. -paste the following into the module

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
       Call Sheet_Color
    End If
End Sub

this will run the change color macro anytime you change the value in cell A2

 

[SubwaySparky]

right click on the sheet1 tab - Click on view code. -paste the following into the module

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$2" Then
       Call Sheet_Color
    End If
End Sub

this will run the change color macro anytime you change the value in cell A2

This works perfect!!! Thank you SO much!