OnSlideShowPageChange Not Advancing Slide - vba

Question

I am trying to run a live clock on every slide in a PowerPoint presentation for a kiosk.
I am able to get the live time to run perfectly and in the preferred format on the first slide. The slide will not advance. The macro will not run on the second slide when advanced manually. Here is my code.
It seems that the code is overriding the default slideshow settings?
Sub OnSlideShowPageChange()
Dim i As Integer
Dim time As Date
time = Now()
time = DateAdd("n", minutes, time)
i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
Do
DoEvents
With ActivePresentation.Slides(i).Shapes("Rectangle 3").TextFrame.TextRange
.Text = Format(Now(), "hh:mm:ss")
End With
Loop
End Sub

Answer 1

I figured out that the slides wouldn't advance because I was stuck in the loop. Here is my fix...but its success is sporadic. Sometimes it will scroll through 5 slides and then get stuck on a slide, other times 2. I am not sure what is happening. Still digging at it.
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
Dim i As Integer
Dim time As Date
Dim tstop As Date
time = Now()
time = DateAdd("n", minutes, time)
tstop = time + TimeValue("00:00:10")
i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
Do Until time = tstop
DoEvents
With ActivePresentation.Slides(i).Shapes("Rectangle 3").TextFrame.TextRange
.Text = Format(Now(), "hh:mm:ss AM/PM")
End With
time = Now()
Loop
End Sub