For Each Loop Isn't Functioning, VBA

Question

This is a silly question, but I can't seem to find the issue with the code after a lot of hunting. I'm creating a For Each loop that finds all incidences of "Friday," goes over to the cell 6 columns over from "Friday" (under the "Overtime" heading), inserts the number 0 in that cell, and changes the number format. Here is my worksheet so far.

Here is my code:

Sub Calendar_Generator()
Dim WS As Worksheet
Dim MyInput As String
Dim StartDay As Date
Dim Sp() As String
Dim a As Integer
Dim R As Long
Dim Match As Range
Dim b As Variant
Dim DayNames() As String
Dim FirstAddress As String
Dim DeleteDays As Range
Dim c As Variant
Dim Day1 As Range
Dim WorkDays As Range
Dim d As Variant
'Dim Fri As Range

    Set WS = ActiveWorkbook.ActiveSheet
    WS.Range("A1:R100").Clear

'This loop is crashing excel
    'Do
        MyInput = InputBox("Enter the start date for the Calendar:")
        'If MyInput = "" Then Exit Sub
    'Loop While Not IsDate(MyInput)
    ' repeat if entry isn't recognized as a date

    ' Set the date value of the beginning of inputted month.
    ' -- regardless of the day the user entered, even if missing
    StartDay = DateSerial(Year(CDate(MyInput)), Month(CDate(MyInput)), 1)

    'Set headers
    Range("a1").Value = Format(StartDay, "mmmm") & " Time Sheet"
    Sp = Split("Day,Date,Time In,Time Out,Hours,Notes,Overtime", ",")
    For a = 0 To UBound(Sp)
        WS.Cells(2, 1 + a).Value = Sp(a)
    Next a

    ' fill the days for the selected month
    ' == the last day of a month is always the day before the first of the next
    '    here deducting 2 to count from 0
    For R = 0 To Day(DateAdd("m", 1, StartDay) - 2)
        With WS.Cells(3 + R, 2)
            .Value = StartDay + R
            .NumberFormat = "d-mmm"
            .Offset(, -1).Value = StartDay + R
            .Offset(, -1).NumberFormat = "dddd"
        End With
    Next R

ReDim DayNames(1)
'To add more headers, change statement to 3
    DayNames(0) = "Saturday"
    DayNames(1) = "Sunday"

For b = LBound(DayNames) To UBound(DayNames)
Set Match = WS.Cells.Find(What:=DayNames(b), LookIn:=xlValues, _
    lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious, _
    MatchCase:=True, SearchFormat:=False)

    If Not Match Is Nothing Then
    FirstAddress = Match.Address
        Do
        Match.EntireRow.Clear
        'Highlight cell containing table heading in green
        Set Match = WS.Cells.FindNext(Match)
        Loop While Not Match Is Nothing
    End If
Next b

Set DeleteDays = Range("A3:A50")
For Each c In DeleteDays
    If c = "" Then
        c.EntireRow.Delete
    End If
Next c

'Works for some reason if it's executed twice
Set DeleteDays = Range("A3:A50")
For Each c In DeleteDays
    If c = "" Then
        c.EntireRow.Delete
    End If
Next c

'Insert and format template time values with formula for hours worked in E3
Set Day1 = Range("B3")
Range(Day1, Day1.End(xlDown)).Select
With Selection
    Selection.Offset(, 1).Value = "8:00 AM"
    Selection.Offset(, 1).NumberFormat = "h:mm AM/PM"
    Selection.Offset(, 2).Value = "4:00 PM"
    Selection.Offset(, 2).NumberFormat = "h:mm AM/PM"
    Selection.Offset(, 3).Value = "0"
    Selection.Offset(, 3).NumberFormat = "h:mm"
    Day1.Offset(, 3).Formula = "=D3-C3"
End With

'Fill in hours worked formula
Day1.Offset(, 3).Select
Selection.AutoFill Destination:=Range(Selection, Selection.End(xlDown))

'*This is the loop that isn't functioning, but also isn't calling any errors*
'Set Overtime calculation
Set WorkDays = Range("A3:A33")
For Each d In WorkDays
    If d = "Friday" Then
        d.Offset(, 6).Value = "0"
        d.Offset(, 6).NumberFormat = "h:mm"
    End If
Next d

End Sub

I've had some trouble with loops crashing Excel since I switched to Excel 365, but this For Each loop isn't crashing it. Any ideas as to why this For Each loop isn't doing its job?