Auto change of data in a cell like a Slide show in ppt

  • Thread starter Thread starter Vital_ar
  • Start date Start date
V

Vital_ar

Dear All,
Recently I have seen a exccel file. In that data of cell (contains proverbs
& quotation's) were auto changing to a new one with a time interval of 45 to
60 secs. How is it possible to change a data in a cell automatically. Is it
possible?
 
Sir,
I don't have so much knowledge on VBA. If possible can you give me a example
of the code.
Thank you very much.
 
Do you want to be able to do other things in Excel while this slide show is
running?


Gord
 
Sir,
Thankyou Very much for the revert sir, No I don't want to do anyother works
in Excel while this file is open.
 
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
 
Back
Top