For Each Loop Isn't Functioning, VBA - excel

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?