Change Values & Color Based on Day

Question

I have this timesheet and based on a day in the row (F8:AJ8) I want its whole column to highlight with yellow (Color index = 44) if it = "Fri" and change their value (Alternate cell on every row) from 10 to 0 but limited to the range named as "Timesheetarea" (F8:AJ131) as at times I add rows.

The problems with the code is when the command button is pressed,

• if F8 was Fri then all 10's are replaced to "" and the color gets filled up to cell F151 (which is on the signature portion and out of the table border)
• if F8 was "Sat" all "" becomes 10 and if pressed for a second time becomes 110, 1110 etc.

I'm trying the code for one column and if it works I will modify it for the rest of the columns from F to AJ.

For the months that do not contain 31 days, that day (31) is automatically "" and its column values will be "" so they don't get added.

This is the formula through F8 - AJ8 that determines the day
=IF(AJ7="","",TEXT(AJ7,"ddd"))

This is the formula that gets the date of the month From cell G7 through AJ7 =IF(F7="","",IF(MONTH(F7)<>MONTH(F7+1),"",F7+1))

Formula for F7 is =IF(F1="","",DATEVALUE("1"&F1))

This way if for example February is 28 days the next 3 cells after 28-2-21 will be blank and their days will show as blank.

Sub fixFri()
  
Application.ScreenUpdating = False
Dim bottoma As Integer
Dim bottomB As Integer
Dim bottomC As Integer
Dim bottomD As Integer
Dim bottomE As Integer
Dim bottomf As Integer
Dim bottomg As Integer
Dim bottomh As Integer
Dim bottomi As Integer
Dim bottomj As Integer
Dim bottomk As Integer
Dim bottoml As Integer
Dim bottomm As Integer
Dim bottomn As Integer
Dim bottomo As Integer
Dim bottomp As Integer
Dim bottomq As Integer
Dim bottomr As Integer
Dim bottoms As Integer
Dim bottomt As Integer
  
Dim bottomu As Integer
Dim bottomv As Integer
Dim bottomw As Integer
Dim bottomx As Integer
Dim bottomy As Integer
Dim bottomz As Integer
Dim bottomaa As Integer
Dim bottomab As Integer
Dim bottomac As Integer
Dim bottomad As Integer
Dim bottomae As Integer
  
bottoma = Range("F" & Rows.Count).End(xlUp).Row
bottomB = Range("G" & Rows.Count).End(xlUp).Row
bottomC = Range("H" & Rows.Count).End(xlUp).Row
bottomD = Range("I" & Rows.Count).End(xlUp).Row
bottomE = Range("J" & Rows.Count).End(xlUp).Row

bottomf = Range("K" & Rows.Count).End(xlUp).Row
bottomg = Range("L" & Rows.Count).End(xlUp).Row
bottomh = Range("M" & Rows.Count).End(xlUp).Row
bottomi = Range("N" & Rows.Count).End(xlUp).Row
bottomj = Range("O" & Rows.Count).End(xlUp).Row

bottomk = Range("P" & Rows.Count).End(xlUp).Row
bottoml = Range("q" & Rows.Count).End(xlUp).Row
bottomm = Range("r" & Rows.Count).End(xlUp).Row
bottomn = Range("s" & Rows.Count).End(xlUp).Row
bottomo = Range("t" & Rows.Count).End(xlUp).Row

bottomp = Range("u" & Rows.Count).End(xlUp).Row
bottomq = Range("v" & Rows.Count).End(xlUp).Row
bottomr = Range("w" & Rows.Count).End(xlUp).Row
bottoms = Range("x" & Rows.Count).End(xlUp).Row
bottomt = Range("y" & Rows.Count).End(xlUp).Row

bottomu = Range("Z" & Rows.Count).End(xlUp).Row
bottomv = Range("aa" & Rows.Count).End(xlUp).Row
bottomw = Range("ab" & Rows.Count).End(xlUp).Row
bottomx = Range("ac" & Rows.Count).End(xlUp).Row
bottomy = Range("ad" & Rows.Count).End(xlUp).Row

bottomz = Range("ae" & Rows.Count).End(xlUp).Row
bottomaa = Range("af" & Rows.Count).End(xlUp).Row
bottomab = Range("ag" & Rows.Count).End(xlUp).Row
bottomac = Range("ah" & Rows.Count).End(xlUp).Row
bottomad = Range("ai" & Rows.Count).End(xlUp).Row
bottomae = Range("aj" & Rows.Count).End(xlUp).Row

Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
   
Dim rng10 As Range
Dim rng11 As Range
Dim rng12 As Range
Dim rng13 As Range
Dim rng14 As Range
Dim rng15 As Range
Dim rng16 As Range
Dim rng17 As Range
Dim rng18 As Range
Dim rng19 As Range
Dim rng20 As Range
Dim rng21 As Range
Dim rng22 As Range
Dim rng23 As Range
Dim rng24 As Range
Dim rng25 As Range
Dim rng26 As Range
Dim rng27 As Range
Dim rng28 As Range
Dim rng29 As Range
Dim rng30 As Range
Dim rng31 As Range

Dim Lday1 As String
Dim Lday2 As String
Dim Lday3 As String
Dim Lday4 As String
Dim Lday5 As String
Dim Lday6 As String
Dim Lday7 As String
Dim Lday8 As String
Dim Lday9 As String
Dim Lday10 As String
Dim Lday11 As String
Dim Lday12 As String
Dim Lday13 As String
Dim Lday14 As String
Dim Lday15 As String
Dim Lday16 As String
Dim Lday17 As String
Dim Lday18 As String
Dim Lday19 As String
Dim Lday20 As String
Dim Lday21 As String
Dim Lday22 As String
Dim Lday23 As String
Dim Lday24 As String
Dim Lday25 As String
Dim Lday26 As String
Dim Lday27 As String
Dim Lday28 As String
Dim Lday29 As String
Dim Lday30 As String
Dim Lday31 As String
   
Dim Ldayvalue As Integer
Lday1 = Range("F8").Value
   
For Each rng1 In Range("F8:F" & bottoma)
    If Lday1 = "Fri" Then
        rng1.Value = Replace(rng1, 10#, 0#)
        rng1.Interior.ColorIndex = 44

    ElseIf Lday1 = "Sat" Then
        rng1.Value = Replace(rng1, 0#, 10#)
        rng1.Interior.ColorIndex = 2

    ElseIf Lday1 = "Sun" Then
        rng1.Value = Replace(rng1, 0#, 10#)
        rng1.Interior.ColorIndex = 2

    ElseIf Lday1 = "Mon" Then
        rng1.Value = Replace(rng1, 0#, 10#)
        rng1.Interior.ColorIndex = 2

    ElseIf Lday1 = "Tue" Then
        rng1.Value = Replace(rng1, 0#, 10#)
        rng1.Interior.ColorIndex = 2

    ElseIf Lday1 = "Wed" Then
        rng1.Value = Replace(rng1, 0#, 10#)
        rng1.Interior.ColorIndex = 2

    ElseIf Lday1 = "Thu" Then
        rng1.Value = Replace(rng1, 0#, 10#)
        rng1.Interior.ColorIndex = 2

    ElseIf Lday1 = "" Then
        rng1.Value = Replace(rng1, 10#, 0#)
        rng1.Value = Replace(rng1, 0#, 0#)
        rng1.Interior.ColorIndex = 2

    End If
Next rng1

End Sub

Answer 1

No need to scan down the sheet, you can use Range.Replace

Sub fixFri()

    Const TIMESHEET = "F8:AJ131"
   
    Dim wb As Workbook, ws As Worksheet
    Dim LastRow As Long, c As Range, d As String
   
    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet
   
    ' scan across timesheet columns
    For Each c In ws.Range(TIMESHEET).Columns
        d = c.Cells(1) ' day
        If d = "" Then
            ' skip
        ElseIf d = "Fri" Then
            c.Interior.Color = RGB(255, 255, 0) ' yellow
            c.Replace 10, 0, lookat:=xlWhole
        Else
            c.Interior.Pattern = xlNone 'no color
            c.Replace 0, 10, lookat:=xlWhole
        End If
        
    Next
    MsgBox "Done", vbInformation

End Sub