VB Calendar Macro to highlight current date

I have a macro that displays a calendar with code to highlight the current date, but this part of the code does not work and the current date is not highlighted.

Sub CalendarMaker()

      ' Unprotect sheet if had previous calendar to prevent error.
       ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
          Scenarios:=False
       ' Prevent screen flashing while drawing calendar.
       Application.ScreenUpdating = False
       ' Set up error trapping.
       On Error GoTo MyErrorTrap
       ' Clear area c5:am5 including any previous calendar.
       Range("C5:AM5").Clear
       ' Use InputBox to get desired month and year and set variable
       ' MyInput.
       MyInput = InputBox("Type in Month and year for Calendar ")
       ' Allow user to end macro with Cancel in InputBox.
       If MyInput = "" Then Exit Sub
       ' Get the date value of the beginning of inputted month.
       StartDay = DateValue(MyInput)
       ' Check if valid date but not the first of the month
       ' -- if so, reset StartDay to first day of month.
       If DAY(StartDay) <> 1 Then
           StartDay = DateValue(Month(StartDay) & "/1/" & _
               Year(StartDay))
       End If
       ' Prepare cell for Month and Year as fully spelled out.
       Range("C5").NumberFormat = "mmmm yyyy"
       ' Center the Month and Year label across c5:am5 with appropriate
       ' size, height and bolding.
       With Range("C5:AM5")
           .ColumnWidth = 2.57
           .HorizontalAlignment = xlCenterAcrossSelection
           .VerticalAlignment = xlCenter
           .Font.Size = 18
           .Font.Bold = True
           .RowHeight = 35
       End With
       
       ' Prepare C7:AM7 for dates with center alignment, size, height
       ' and bolding.
       With Range("C7:AM7")
           .ColumnWidth = 2.57
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
           .Font.Size = 10
           .Font.Bold = True
           .RowHeight = 12.75
       End With
       ' Put inputted month and year fully spelling out into "c5".
       Range("C5").Value = Application.Text(MyInput, "mmmm yyyy")
       ' Set variable and get which day of the week the month starts.
       DayofWeek = Weekday(StartDay)
       ' Set variables to identify the year and month as separate
       ' variables.
       CurYear = Year(StartDay)
       CurMonth = Month(StartDay)
       ' Set variable and calculate the first day of the next month.
       FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
       ' Place c "1" in cell position of the first day of the chosen
       ' month based on DayofWeek.
       Select Case DayofWeek
           Case 1
               Range("C7").Value = 1
           Case 2
               Range("D7").Value = 1
           Case 3
               Range("E7").Value = 1
           Case 4
               Range("F7").Value = 1
           Case 5
               Range("G7").Value = 1
           Case 6
               Range("H7").Value = 1
           Case 7
               Range("I7").Value = 1
       End Select
       ' Loop through range C7:AM7 incrementing each cell after the "1"
       ' cell.
       For Each cell In Range("C7:AM7")
           ColCell = cell.Column
           ' Do if "1" is in first column.
           If cell.Column = 1 Then
           ' Do if current cell is not in 1st column.
                ElseIf cell.Column <> 1 Then
                    If cell.Offset(0, -1).Value >= 1 Then
                        cell.Value = cell.Offset(0, -1).Value + 1
                            'Stop when the last day of the month has been
                            'entered
                            If cell.Value > (FinalDay - StartDay) Then
                                cell.Value = ""
                                ' Exit loop when calendar has correct number of
                                ' days shown.
                       Exit For
                   End If
               End If
             ' Stop when the last day of the month has been entered.
             If cell.Value > (FinalDay - StartDay) Then
                 cell.Value = ""
                 ' Exit loop when calendar has correct number of days
                 ' shown.
                 Exit For
             End If
        End If
    Next
    
    For Each cell In Range("C7:AM7")

        If cell.Value = "=TODAY()" Then
        
            With Range("C7:AM7")
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=Today()"
                .FormatConditions(1).Interior.ColorIndex = 1
            End With
        
        End If
    Exit For
    
   Next
    
      
      ' Turn on gridlines
       ActiveWindow.DisplayGridlines = True
       ' Protect sheet to prevent overwriting the dates.
       ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
          Scenarios:=True

       ' Prevent going to error trap unless error found by exiting Sub
       ' here.
       Exit Sub
   ' Error causes msgbox to indicate the problem, provides new input box,
   ' and resumes at the line that caused the error.
MyErrorTrap:
       MsgBox "You may not have entered your Month and Year correctly." _
           & Chr(13) & "Spell the Month correctly" _
           & " (or use 3 letter abbreviation)" _
           & Chr(13) & "and 4 digits for the Year"
       MyInput = InputBox("Type in Month and year for Calendar")
       If MyInput = "" Then Exit Sub
       Resume
   
 End Sub

Suggestions?

Thanks,
jlcford