Full Screen Coding - vba

Question

I have the following code that loads a worksheet in full screen for 1 minute, and then moves onto the next worksheet in the workbook, using the exactly the same methodology.
This is to show stats on a big screen, looping through several stats pages.
This works perfectly on Excel 2007 and 2010.
Yet when the same code is executed on Excel 2013, Excel simply maxes out 1 core of my CPU and stays at not responding. I cannot even Escape to break the code execution. Stepping through the code line by line works fine on all versions.
'Loads up Daily Dispatch Figures worksheet
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
Range("A1").Select
Range("A1:C36").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
Application.DisplayFullScreen = True
Application.ScreenUpdating = True
' Stays on this screen for 1 min
TimVal = Now + TimeValue("0:01:00")
Do Until Now >= TimVal
Loop

Answer 1

Ooo, don't do this:
' Stays on this screen for 1 min
TimVal = Now + TimeValue("0:01:00")
Do Until Now >= TimVal
Loop
Try this:
Application.OnTime Now + TimeValue("0:01:00"), "ProcedureToRun"
You don't want to catch your application in an infinite loop with no sleeps.
Any time you sit in an infinite loop without sleeping, it will use 100% of your Processor time doing nothing. Application.OnTime "schedules" an event and returns control to the Excel UI Thread instead of infinitely looping.
You can read more here: https://msdn.microsoft.com/en-us/library/office/ff196165.aspx
I'm not sure what you're doing after your loop, but you need to make sure you have the code in a separate subroutine and call it.
Here is a Subroutine to go to the next sheet.
Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
End Sub
You can add the Application.OnTime to the end of it and have it call itself:
Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
Application.OnTime Now + TimeValue("00:01:00"), MoveNext
End Sub
This way it will loop and go from sheet to sheet forever (or until you stop it in whatever method you choose to use).
Finally, you can cancel this by storing the scheduled time and using Scheduled:=False.
Your final code could look something like this:
Public scheduledTime as Date
Sub StartDisplaying()
'Your start code:
'---------------------------------------------
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
Range("A1").Select
Range("A1:C36").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
Application.DisplayFullScreen = True
Application.ScreenUpdating = True
'---------------------------------------------
scheduledTime = Now + TimeValue("00:01:00")
Application.OnTime scheduledTime, MoveNext
End Sub
Sub StopDisplaying()
'Your stop code:
'---------------------------------------------
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
ActiveWindow.Zoom = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
Application.DisplayFullScreen = False
Application.ScreenUpdating = True
'---------------------------------------------
Application.OnTime EarliestTime:=scheduledTime, Procedure:="MoveNext", Schedule:=False
End Sub
Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
scheduledTime = Now + TimeValue("00:01:00")
Application.OnTime scheduledTime, MoveNext
End Sub