Countdown slide in Slide show

I have a PPSM file that I am running on a kiosk computer 24/7.  There is one slide that I am counting down to a future date and I am trying to get it to update automatically and not having much luck.  I was wondering if anyone had any advice on how to get this work so that I do not have to go in everyday to update one slide.

I am using this code to "trigger" the slide update:

Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
   If Wn.View.CurrentShowPosition = 1 Then
       Countdown
   End If
End Sub

and then this is what I am using to update the slide:

Sub Countdown()

    Dim Days As Date
    'Launch date
    Days = DateSerial(2022, 2, 14)

    ActivePresentation.Slides(1).Shapes("countdown").TextFrame.TextRange = "Countdown to" & vbCrLf & "Valentines " & vbCrLf & DateDiff("d", Now(), Days) & " Days"
        ActivePresentation.Slides(1).Shapes("countdown") _
        .TextFrame.TextRange.Characters(14, 2).Font.Name = "Nobel-Bold"
        ActivePresentation.Slides(1).Shapes("countdown") _
        .TextFrame.TextRange.Characters(25, 8).Font.Size = 120
        ActivePresentation.Saved = True
        
End Sub

Any advice would be appreciated.  Thank you!!