Problem with building count down timer in Excel using VBA - excel

I was trying to build a count down timer using VBA, and the result can be dynamically output to an Excel cell. I let procedure abc and def recursively call each other (did not set a stop point just for testing), and it worked. However, later with this exact same code I ran again, it failed, and error message was:
Code execution has been interrupted.
Just can't figure out why, I didn't change anything, how could it work and then fail?
I tried On Error Resume Next and Application.DisplayAlert = False, both don't stop the error message popping up and the interruption of the code execution. And if I step through the procedures, it seems fine...
Also I wish to add a dynamic text like "start in how many seconds" like in the comment in another cell. Can it be realized in this way?
Thank you!
Sub abc()
[a1] = [a1] - 1
' [a2] = "Start in " & [a1] & " seconds."
Call def
End Sub
Sub def()
Application.Wait (Now + TimeValue("0:00:01"))
Call abc
End Sub

Rather than trying to do this recursively, with concerns about the call stack, I would use Application.OnTime.
Sub Button1_Click()
Call MyTimer
End Sub
Sub MyTimer()
[a1] = [a1] - 1
Application.OnTime Now + TimeValue("00:00:01"), "MyTimer"
End Sub
I suppose this is still 'recursive' in a fashion, but the procedure exits each time. Only after 1 second has elapsed does it execute the procedure again.
But, either way, you should include some means of stopping the process. For example,
Sub MyTimer()
[a1] = [a1] - 1
If [a1] > 0 Then
Application.OnTime Now + TimeValue("00:00:01"), "MyTimer"
End If
End Sub

Your entire code is working fine for me (also including the [a2] part). I'm on Windows 7 with Excel 2013.
I suggest you include a stopping condition to abc() like
If [a1] > 0 Then
Call def
End If
Please provide some more information.

Why not create a function btw? Does it work for you?
Function wait(seconds As Long)
Dim originalStatusBar As String, i As Long
originalStatusBar = Application.StatusBar
For i = seconds To 0 Step -1
Application.wait (Now + TimeValue("0:00:01"))
Application.StatusBar = "Start in " & i & " seconds"
Next
Application.StatusBar = originalStatusBar
End Function
Then in your sub you just call it like so:
wait 5 'waits 5 seconds and updates status bar with remaining time
or
wait [a1]-1

Related

Application.OnTime doesn't wait

I have some graphs that are updated based on the value in one cell. I am trying to write a script that changes the value in this cell every second and updates the graphs in the process. However, the program does not seem to wait one second to call the procedure and rather runs everything directly. I have tried other methods such as Application.wait which works in regards to waiting but it does not update the graphs. From information I have found on the internet, it seems like Application.OnTime is the best option. Could someone help me figure out why Application.OnTime does not wait one second? Here is my code:
Sub graphOverTime()
Do While Range("N5").Value = "Running"
'changes cell N5 to Not running on condition
Call my_procedure
'Update value in D3 that impacts the graphs
current_month = Range("D3").Value
Range("D3").Value =
Application.WorksheetFunction.EoMonth(current_month, 1)
DoEvents
'Wait one second to rerun procedure
Application.OnTime Now + TimeValue("0:00:01"), "graphOverTime"
Loop
End Sub
Your main problem is Do While looping which causes Application.OnTime to set overlapping scheduled calls of graphOverTime. Following is one way of doing what you wanted to in the first place
Sub graphOverTime()
If Range("N5").Value = "Running" Then
'changes cell N5 to Not running on condition
Call my_procedure
'Update value in D3 that impacts the graphs
Range("D3").Value = Application.WorksheetFunction.EoMonth(Range("D3").Value, 1)
DoEvents
'Wait one second to rerun procedure
Application.OnTime Now + TimeValue("0:00:01"), "graphOverTime", False
End If
End Sub

VBA Excel: Macro should start after timer expires

I am working with Visual Basic Application on Excel. I have a Macro, which should be executed after a time delay. I want to track the waiting time with a timer meanwhile.
I have created an additional module in which I have the following functions:
Public Sub start_time()
Application.OnTime Now + TimeValue("00:00:01"), "next_moment"
End Sub
Public Sub end_time()
Application.OnTime Now + TimeValue("00:00:01"), "next_moment", , False
End Sub
Public Sub next_moment()
If Worksheets("Messwerte").Range("A1").Value = 0 Then Exit Sub
Worksheets("Messwerte").Range("A1").Value = Worksheets("Messwerte").Range("A1").Value - TimeValue("00:00:01")
start_time
End Sub
I have my timer in the cell Worksheets("Messwerte").Range("A1").Value.
The structure of my code is now the following:
For Loop
Code Block 1
Call start_time #Waiting should be applied here
Code Block 2
End For Loop
My problem is now that the timer starts at start_time, but Code Block 2 is also starting. I want to have my timer and when my timer shows "00:00:00" then Code Block 2 should start.
On the forums I just found solutions to either having a timer or to wait until the code is continued but not both working like I want to.
Does someone has a solution on this?
Thanks
I found a solution, which is not clean, but it does work. Hopefully it helps you.
I created a function, which is a boolean and becomes false, when the timer is on 0.
Public Function Check_Time() As Boolean
If Sheets("Timer_Tabular").Range("Timer_Position").Value = 0 Then
Check_Time = False
Else
Check_Time = True
End If
End Function
The code has the following structure:
#Code before the waiting
Dim Waiting as Boolean
Waiting = True
'Wait until timer is zero
Do While Waiting
If Check_Time() = True Then
'Enables working on excel while doing nothing.
DoEvents
ElseIf Check_Time() = False Then
Waiting = False
Exit Do
End If
Loop
#Code Block, which is executed after waiting time.
So the Macro is catched at this point inside the while loop and the while loop breaks, when the timer is 0. The DoEvents "unfreezes" the excel screen.
Endresult is: The macro code stops running, but the timer goes on. If the timer is 0 the code will be continued.

How can you implement a looping timer? Is it possible to vary the time delay?

I'm trying to make code which moves the active cell downwards every x seconds (with hopefully x<1), and am having some issues.
Firstly, the following line of code bugs out at the 4th line when I run it, saying: "Cannot run the macro "__". The macro may not be available in this workbook or all macros may be disabled".
I cannot find any fixes for this online - is there an error in this Sub or is this an issue with my setup of Excel which can be easily fixed?
Public Sub Time_Practice()
Debug.Print "Hello, it is " & Timer
Timer = Now + TimeValue("00:00:01")
Application.OnTime Timer, "Time_Practice"
End Sub
Secondly, the actual code I would like to run is the stuff below, but where I can vary TimeValue("00:00:01") by using a variable such as Added_Time.
By this I mean, if something has happened Y times, I would like the new value for Added_Time = TimeValue("00:00:01") - 0.01 * Y (i.e. if it has happened 10 times, I would like the time gap to be 0.9 seconds).
Would the following line of code be valid and work ok?
Dim Timer As Double, Dim Y as Double
Public Sub Movement()
ActiveCell.Offset(1, 0).Activate
Timer = Now + TimeValue("00:00:01") - 0.01 * Y
Application.OnTime Timer, "Movement"
End Sub
Thanks in advance

How to refresh Excel file every second?

I have a list of stock prices pulled from Google finance and placed in different sheets in my Excel. I'm wondering, Can I refresh Excel sheet every SECOND (not minute) according to the Google finance stock price?
This can be done without having a macro constantly running. It relies on the Application.OnTime method which allows an action to be scheduled out in the future. I have used this approach to force Excel to refresh data from external sources.
The code below is based nearly exclusively on the code at this link: http://www.cpearson.com/excel/ontime.aspx
The reference for Application.OnTime is at: https://msdn.microsoft.com/en-us/library/office/ff196165.aspx
Dim RunWhen As Date
Sub StartTimer()
Dim secondsBetween As Integer
secondsBetween = 1
RunWhen = Now + TimeSerial(0, 0, secondsBetween)
Application.OnTime EarliestTime:=RunWhen, Procedure:="CodeToRun", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="CodeToRun", Schedule:=False
End Sub
Sub EntryPoint()
'you can add other code here to determine when to start
StartTimer
End Sub
Sub CodeToRun()
'this is the "action" part
[A1] = WorksheetFunction.RandBetween(0, 100)
'be sure to call the start again if you want it to repeat
StartTimer
End Sub
In this code, the StartTimer and StopTimer calls are used to manage the Timers. The EntryPoint code gets things started and CodeToRun includes the actual code to run. Note that to make it repeat, you call StartTimer within CodeToRun. This allows it to loop. You can stop the loop by calling the StopTimer or simply not calling StartTimer again. This can be done with some logic in CodeToRun.
I am simply putting a random number in A1 so that you can see it update.
Sub RefreshFormulasEverySecond()
Dim dtTargetTime As Date
Debug.Print "Started"
Do While Range("A1").Value <> "STOP"
Application.Calculate
dtTargetTime = Now + TimeValue("0:00:01")
Do While Now < dtTargetTime
DoEvents
Loop
Debug.Print Now
Loop
Debug.Print "Stopped"
End Sub
You could have this macro running in the background. Paste it into a VBA module. You can run it from there or else put a button on the sheet and use that to trigger it. It's written to stop running when the word "STOP" is typed in cell A1 of whatever sheet the user is looking at.
I'm not sure it's the greatest idea to have a macro running continuously in the background, but that was the only way I could think of.

Bloomberg data doesn't populate until Excel VBA macro finishes

I'm running a macro in a blank Excel 2007 workbook on a PC with a Bloomberg license. The macro inserts Bloomberg functions into sheet1 that pull yield curve data. Some additional functions' results are dependent on the first functions finishing and correctly displaying the Bberg data. When I step through the program it only displays '#N/A Requesting Data . . .' instead of the results of the query, no matter how slowly I go. Because some of the functions are dependent on string and numeric field results being populated, the program hits a run-time error at that code. When I stop debugging -- fully ending running the program -- all the Bberg values that should have populated then appear. I want these values to appear while the program is still running.
I've tried using a combination of DoEvents and Application.OnTime() to return control to the operating system and to get the program to wait for a long time for the data update, but neither worked. Any ideas would be helpful. My code is below. wb is a global-level workbook and ws1 is a global level worksheet.
Public Sub Run_Me()
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
Call Populate_Me
Call Format_Me
'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
End Sub
Private Sub Populate_Me()
Dim lRow_PM As Integer
Dim xlCalc As XlCalculation
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
'clear out any values from previous day
If wb.Sheets(ws1.Name).Range("A1").Value <> "" Then
wb.Sheets(ws1.Name).Select
Selection.ClearContents
End If
xlCalc = Application.Calculation
Application.Calculation = xlCalculationAutomatic
Range("A1").Value = "F5"
Range("B1").Value = "Term"
Range("C1").Value = "PX LAST"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=BDS(""YCCF0005 Index"",""CURVE_MEMBERS"",""cols=1;rows=15"")"
BloombergUI.RefreshAllStaticData
Range("B2").Select
ActiveCell.FormulaR1C1 = "=BDS(""YCCF0005 Index"",""CURVE_TERMS"",""cols=1;rows=15"")"
BloombergUI.RefreshAllStaticData
Application.OnTime Now + TimeValue("00:00:10"), "HardCode"
'******more code*******'
End Sub
Sub HardCode()
Range("C2").Select
ActiveCell.FormulaR1C1 = "=BDP($A2,C$1)"
BloombergUI.RefreshAllStaticData
End Sub
A way to get around this issue is to put all subs, etc that you want to run after pulling the bloomberg data into a different sub. You must do this each time you call Bloomberg information. If you call another sub in the "master" sub after the Application.OnTime Now +TimeValue("00:00:15"), it will fail- you must put all subs following into a new master sub.
For example:
Instead of
Sub Master1()
Application.Run "RefreshAllStaticData"
Application.OnTime Now + TimeValue("00:00:15"), "OtherSub1"
'This will cause the Bloomberg Data to not refresh until OtherSub2 and 3 have run
OtherSub2
OtherSub3
End Sub
It should be
Sub Master1()
Application.Run "RefreshAllStaticData"
Application.OnTime Now + TimeValue("00:00:15"), "Master2"
End Sub
Sub Master2()
OtherSub1
OtherSub2
OtherSub3
End Sub
Hope that helps
I googled for BloombergUI.RefreshAllStaticData and was immediately taken to this Mr Excel page: http://www.mrexcel.com/forum/showthread.php?t=414626
We are not supposed post answers which are only links in case that link disappears and takes the answer with it. However, I am not sure I understand the question or the answer well enough to summarise it.
The Google link will probably exist for the forseeable future.
Within Mr Excel, the chain is: MrExcel Message Board > Question Forums > Excel Questions > Bloomberg links and macros.
The key information appears to be:
On your Bloomberg terminal if you type in WAPI < GO > you will find listings of the Bloomberg API and downloadable examples.
Using the helpfile information in that area we can build a more robust solution to this using the Bloomberg Data Type Library. Go to Tools | References and add a reference to this library. This code can then be used to populate the cells:
Sub Test2()
Dim vResults, vSecurities, vFields
Dim objBloomberg As BLP_DATA_CTRLLib.BlpData
'fill our arrays - must be 1 dimension so we transpose from the worksheet
With Application.WorksheetFunction
vSecurities = .Transpose(Sheet1.Range("B2:B4").Value)
vFields = .Transpose(.Transpose(Range("C1:H1").Value))
End With
Set objBloomberg = New BLP_DATA_CTRLLib.BlpData
objBloomberg.AutoRelease = False
objBloomberg.Subscribe _
Security:=vSecurities, _
cookie:=1, _
Fields:=vFields, _
Results:=vResults
Sheet1.Range("C2:H4").Value = vResults
End Sub
Once you have tried out Mr Excel's solution, perhaps you could update this answer for the benefit of future visitors.
I gathered some information from around the web and wrote what imho is an improved version in comparison with everything I have found so far:
Private WaitStartedAt As Double
Private Const TimeOut As String = "00:02:00"
Public Function BloomCalc(Callback As String) As Boolean
Dim rngStillToReceive As Range
Dim StillToReceive As Boolean
Dim ws As Worksheet
StillToReceive = False
If WaitStartedAt = 0 Then
WaitStartedAt = TimeValue(Now())
End If
If TimeValue(Now()) >= WaitStartedAt + TimeValue(TimeOut) Then
GoTo errTimeOut
End If
For Each ws In ActiveWorkbook.Worksheets
Set rngStillToReceive = ws.UsedRange.Find("*Requesting Data*", LookIn:=xlValues)
StillToReceive = StillToReceive Or (Not rngStillToReceive Is Nothing)
Next ws
If StillToReceive Then
BloomCalc = False
Application.OnTime Now + (TimeSerial(0, 0, 1)), Callback
Else
WaitStartedAt = 0
BloomCalc = True
End If
Exit Function
errTimeOut:
Err.Raise -1, , "BloomCalc: Timed Out. Callback = " & Callback
End Function
It should an arbitrary task by calling a sub like DoSomething()
Public Sub DoSomething()
DoSomethingCallback
End Function
That calls a "callback" function that will call itself until either the data has been refreshed or the time limit reached
Public Sub AutoRunLcbCallback()
If BloomCalc("AutoRunLcbCallback") Then
MsgBox "Here I can do what I need with the refreshed data"
' for instance I can close and save the workbook
ActiveWorkbook.Close True
End If
End Sub
Any comment is appreciated. A possible improvement might be to allow the workbook and / or worksheet to be an input of the function but I really didn't see the need for that.
Cheers
Hello there I think I have found a solution to this problem and I really want to share this with you guys.
Before starting with the real answer I want to make sure everyone understands how Application.OnTime actually works. And If you already know then you can safely skip to THE SOLUTION below.
Let's make a TOY EXAMLPE example with two subroutines Sub First() and Sub Second() and one variable x that is declared outside, so that it has scope inside the whole Module
Dim x as integer
Sub First()
x = 3
Application.OnTime Now + TimeSerial(0, 0, 2), "Sub2"
x = 2*x
End Sub
Sub Second()
x = x + 1
End Sub
I thought that the commands were executed in the following order:
x = 3
Application.OnTime Now + TimeSerial(0, 0, 2), "Sub2"
Then after 2 seconds of wait, in Sub Second() x = x + 1, hence 4
Finally we go back to Sub First() where x = 2*x , so that in the end x is equal to 8.
It turns out that this is not the way VBA operates; what happens instead is:
x = 3
Application.OnTime Now + TimeSerial(0, 0, 2), "Sub2"
Here the remaing code in Sub First() is executed until THE END, before switching to Sub Second().
So x = 2*x is executed right away along with every line of code that appears until the end of Sub First(). Now x is equal to 6.
Finally, after 2 seconds of waiting it executes the instruction in Sub Second(), x = x + 1, so that in the end x is equal to 7
This happens independently of how much time you make the application wait. So for instance if in my example, after
Application.OnTime Now + TimeSerial(0, 0, 2), "Sub2"
VBA took 10 seconds to execute the line
x = 2*x
it would still have to finish the execution of that command before switching to Sub Second().
WHY IS THIS IMPORTANT?
Because in the light of what I just explained I can now show you my solution to the OP question. Then you can adapt it to your needs.
And YES!!! This works with For Loops too!
THE SOLUTION
I have two subroutines:
BLPDownload() one where I refresh a workbook and I have to wait for the values to be dowloaded in order to execute some other code ...
BLPCheckForRefresh() where I check if all data have been downloaded
So just like before, I declare two variables with Module-Level Scope
Dim firstRefreshDone As Boolean, Refreshing As Boolean
Sub BLPDownload()
CHECK:
What I do right below is to:
check if I already told VBA to Refresh the workbook. Of course the first time you run the macro you have not; hence firstRefreshDone = False and it steps into this block of the if statement.
next it calls the other Sub BLPCheckForRefresh() and it exits the current Subroutine.
And this is the trick. To Exit the Subroutine after calling Application.OnTime*
Inside BLPCheckForRefresh() what happens is
that I set the value of firstRefreshDone = True
check if, in the UsedRange, I have cells wiht #N/A Requesting Data. If I have, the value of Refreshing = True.
finally I call back the Sub BLPDownload()
If Not firstRefreshDone Then
Application.Run "RefreshEntireWorkbook"
Application.Run "RefreshAllStaticData"
Application.OnTime Now + TimeSerial(0, 0, 4), "BLPCheckForRefresh"
Exit Sub
This time though, firstRefreshDone = True so, if also the refreshing is finished it goes to AFTER_REFRESH where you can put all the code you want, else ...
ElseIf Not Refreshing Then
GoTo AFTER_REFRESH
if the refresh is not finished, i.e. if I have cells wiht #N/A Requesting Data it calls the other Sub BLPCheckForRefresh() and it exits the current Subroutine again.
This funny game goes on and on until we have no more #N/A Requesting Data in our UsedRange
Else
Refreshing = False
Application.OnTime Now + TimeSerial(0, 0, 4), "BLPCheckForRefresh"
Exit Sub
End If
AFTER:
some code ...
End Sub
This is the sub where I check if refreshing is done.
Sub BLPCheckForRefresh()
Dim rng As Range, cl As Range
Set rng = Foglio1.UsedRange
As explained above here I set the value of firstRefreshDone = True
firstRefreshDone = True
And this is the loop where i go through each cell in the usedrange looking for #N/A Requesting Data
On Error Resume Next
For Each cl In rng
If InStr(cl.Value2, "#N/A Request") > 0 Then
Refreshing = True
Exit For
End If
Next cl
On Error GoTo 0
Finally I call back the Sub BLPDownload()
Call BLPDownload
End Sub
So this is my solution. I works for me and with another dirty trick that exploits always the GoTo statements and another Module-Level Scope variable that keeps count of the number of iteration it is possible to use this structure in For Loops too.
That being said I want to point out that in my opinion the best solution to this problem is to use Bloomberg API as suggested by Tony Dallimore.
Hope this helps!!

Resources