OK
We can use Application.Wait in that case.
Assumes your list of proverbs/phrases is in Column A
This code will cycle through the cells from bottom to top.
Needs to be restarted at end of cycle.
Sub Slide_Show()
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
FirstRow = 1
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 3 '3 for testing..........adjust
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
If Application.Wait(Now + TimeValue("0:00:03")) Then '03 for test
Range("G1").Value = Cells(iRow, 1).Value
End If
Next iRow
End Sub
If you wanted to be able to use Excel between slides and have a continuously
looping cycle you would use OnTime code.
This would be my preference.
Assumes the proverbs start in A2 in column A
See below................
Public RunWhen As Double
Public Const cRunIntervalSeconds = 5 '5 secs test adjust to suit
Public Const cRunWhat = "TheSub" ' the name of the procedure to run
Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub
Sub TheSub()
Dim iRow As Long
Dim iCounter As Long
Dim FirstRow As Long
Dim LastRow As Long
FirstRow = 2
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
iCounter = Range("H1").Value
With Range("H1")
If .Value < 2 Then
.Value = LastRow
Else
.Value = iCounter - 1
End If
End With
For iRow = iCounter To FirstRow Step -1
Range("G1").Value = Cells(iCounter, 1).Value
Next
StartTimer
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=False
End Sub
Gord
