Change Values & Color Based on Day-CodePudding

I've been trying tirelessly to find a solution and have come this close to the solution I'm looking for. I'm somewhat a beginner in VBA coding and have been learning by trying out codes which im looking for certain functionality.

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 have to add rows.

The problems im facing with the below code is when the command button is pressed, if F8 was Fri then all 10's are replaced to "" and the color gets filled upto cell F151 (Which is on the signature portion and out of the table border) and if F8 was "Sat" all "" become 10 and if pressed for a second time becomes 110, 1110 etc.

Im trying out the code for one column and if it works i will modify it for the rest of the columns from F to AJ.

Also note that the months that do not contain 31 days, that day (31) is automatically "" and its column values will be "" so they dont 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

CodePudding user response：

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