How to interrupt live Clock loop for next slide transition? - vba

Question

This is my first time ever programming something and I have managed to create a macro for a live clock on a Powerpoint (2016) presentation. The macro works perfectly, activating on my designated named slide only. However, I cannot find a way to interrupt the "Do Until clock=false" loop so that the presentation can advance to the next slide. The idea is for the presentation to be on a continuous loop so I need to macro to stop after the designated slide to avoid any lagging when cycling through.
I have tried to include a timevalue function to add a time onto the current time and give a place to stop, but this seems to have no effect.
Any help would be much appreciated!
Public clock As Boolean
Private Sub Pause()
Dim PauseTime, start
PauseTime = 1
start = Timer
Do While Timer < start + PauseTime
DoEvents
Loop
End Sub
Sub OnSlideshowPageChange(Wn As SlideShowWindow)
Dim currenttime, currenttimecount As Date
Dim currentdate, currentday As String
If Wn.View.Slide.Name = "autoclock 1" Then clock = True
Do Until clock = False
On Error Resume Next
If Weekday(Now) = 1 Then currentday = "Sunday"
If Weekday(Now) = 2 Then currentday = "Monday"
If Weekday(Now) = 3 Then currentday = "Tuesday"
If Weekday(Now) = 4 Then currentday = "Wednesday"
If Weekday(Now) = 5 Then currentday = "Thursday"
If Weekday(Now) = 6 Then currentday = "Friday"
If Weekday(Now) = 7 Then currentday = "Saturday"
currentdate = FormatDateTime(Now, vbLongDate)
currenttime = FormatDateTime(Now, vbLongTime)
currenttimecount = currenttime + TimeValue("00:00:10")
If currenttime = currenttimecount Then clock = False
If clock = False Then SlideShowWindows(1).View.Next
activepresentation.Slides(SlideShowWindows(1).View.CurrentShowPosition).Shapes("shpDayClockAuto").TextFrame.TextRange.Text = currentday & Space(20) & currentdate & Space(15) & currenttime
Pause
Loop
End Sub
Private Sub OnSlideshowTerminate(SW As SlideShowWindow)
clock = False
End Sub