Application.OnTime.... Calculate every 200 milliseconds. Is there a way?

M

mtheriault2000

Well-known Member
Joined
Oct 23, 2008
Messages
826
Hello

The function Application.OnTime could be use to refresh or recalculate a cell with the minimal interval of 1 second. Is there a way to have the function using a 200 milliseconds interval?

Martin
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
I don't believe so....On time has a minimum of 1 second !.....besides if there was the slightest delay in the recalc, your system would error out !!!
 
Upvote 0
mtheriault2000 said:
The function Application.OnTime could be use to refresh or recalculate a cell with the minimal interval of 1 second. Is there a way to have the function using a 200 milliseconds interval?
Click to expand...

In theory, yes, at least on a PC. (I don't know anything about a Mac.)

But 200 milliseconds might be too frequent, due to VBA and/or system overhead (process switch?).

The code below had the following results in one example run.

Rich (BB code): 
 0            9/04/2017 20:06:50.305                    0.000346,230
 1            9/04/2017 20:06:50.586      0.281         0.000361,711
 2            9/04/2017 20:06:51.117      0.531         0.000360,956
 3            9/04/2017 20:06:51.648      0.531         0.000362,088
 4            9/04/2017 20:06:52.180      0.531         0.000363,599
 5            9/04/2017 20:06:52.398      0.219         0.000409,284
 6            9/04/2017 20:06:52.711      0.313         0.000368,507
 7            9/04/2017 20:06:53.242      0.531         0.000358,690
 8            9/04/2017 20:06:53.773      0.531         0.000359,068
 9            9/04/2017 20:06:54.305      0.531         0.000361,711
 10           9/04/2017 20:06:54.828      0.523         0.000009,817

Although the minimum interval time (column 4) was about 219 milliseconds, the typical interval time was about 531 milliseconds.

It is not likely that the overhead is due to the execution time (column 5) for "myevent" per se. That is typically less than 400 microseconds on my CPU.

The code....

Rich (BB code): 
Const n As Long = 10
Dim i As Long
Dim evtime(0 To n) As Double
Dim st(0 To n) As Currency, et(0 To n) As Currency


Sub doit()
Dim j As Long
Application.StatusBar = "Running...."
DoEvents
i = -1
myevent
End Sub


Sub myevent()
Dim d As Double, t As Double
QueryPerformanceCounter st(i + 1)
d = Date: t = Timer
If d <> Date Then d = Date: t = Timer    ' race condition
i = i + 1
evtime(i) = d + t / 86400
If i < n Then
    Application.OnTime d + (t + 0.2) / 86400, "myevent"
    QueryPerformanceCounter et(i)
Else
    QueryPerformanceCounter et(i)
    Debug.Print vbNewLine & "=========="
    Debug.Print 0, WorksheetFunction.Text(evtime(0), "m/dd/yyyy hh:mm:ss.000"), , _
        Format(convertmytimer(et(0) - st(0)), "0.000000\,000")
    For i = 1 To n
        Debug.Print i, WorksheetFunction.Text(evtime(i), "m/dd/yyyy hh:mm:ss.000"), _
            WorksheetFunction.Text(evtime(i) - evtime(i - 1), ".000"), _
            Format(convertmytimer(et(i) - st(i)), "0.000000\,000")
    Next
    Application.StatusBar = "Done"
    MsgBox "Done"
End If
End Sub


The unlikely race condition might arise when Date and Timer are called separately during the last system clock tick of the day, which rolls over to the next day in the interim.

QueryPerformanceCounter and myconvertimer are defined in a separate module....

Rich (BB code): 
Public Declare Function QueryPerformanceFrequency Lib "kernel32" _
   (ByRef freq As Currency) As Long
Public Declare Function QueryPerformanceCounter Lib "kernel32" _
   (ByRef cnt As Currency) As Long   
Private freq As Currency, df As Double


Function convertmytimer(ByVal dt As Currency) As Double
If freq = 0 Then QueryPerformanceFrequency freq: df = freq
convertmytimer = dt / df
End Function
 
Last edited:
Upvote 0
A more reliable method, courtesy of Charles Pearson (click here) [1]....

[1] http://www.cpearson.com/excel/OnTime.aspx

Rich (BB code): 
Private Const n As Long = 10
Private i As Long
Private evtime(0 To n) As Double
Private st(0 To n) As Currency, et(0 To n) As Currency

Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long
Private TimerID As Long
Private Const TimerSeconds As Single = 0.2


Private Sub doit()
Dim d As Double, t As Double
Application.StatusBar = "Running...."
DoEvents
QueryPerformanceCounter st(0)
i = 0
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf myevent)
d = Date: t = Timer
If d <> Date Then d = Date: t = Timer    ' race condition
evtime(0) = d + t / 86400
QueryPerformanceCounter et(0)
End Sub


Private Sub myevent()
Dim d As Double, t As Double
QueryPerformanceCounter st(i + 1)
d = Date: t = Timer
If d <> Date Then d = Date: t = Timer    ' race condition
i = i + 1
evtime(i) = d + t / 86400
QueryPerformanceCounter et(i)
If i = n Then
    On Error Resume Next
    KillTimer 0&, TimerID
    Debug.Print vbNewLine & "=========="
    Debug.Print 0, WorksheetFunction.Text(evtime(0), "m/dd/yyyy hh:mm:ss.000"), , _
        Format(convertmytimer(et(0) - st(0)), "0.000000\,000")
    For i = 1 To n
        Debug.Print i, WorksheetFunction.Text(evtime(i), "m/dd/yyyy hh:mm:ss.000"), _
            WorksheetFunction.Text(evtime(i) - evtime(i - 1), ".000"), _
            Format(convertmytimer(et(i) - st(i)), "0.000000\,000")
    Next
    Application.StatusBar = "Done"
    MsgBox "Done"
End If
End Sub


Refer to my previous posting for the code for QueryPerformanceCounter and convertmytimer.

Example run....

Rich (BB code): 
 0            9/04/2017 23:16:37.781                    0.000017,746
 1            9/04/2017 23:16:37.984      0.203         0.000009,439
 2            9/04/2017 23:16:38.187      0.203         0.000010,194
 3            9/04/2017 23:16:38.391      0.203         0.000004,908
 4            9/04/2017 23:16:38.594      0.203         0.000013,970
 5            9/04/2017 23:16:38.797      0.203         0.000011,327
 6            9/04/2017 23:16:39.000      0.203         0.000007,174
 7            9/04/2017 23:16:39.203      0.203         0.000010,194
 8            9/04/2017 23:16:39.406      0.203         0.000010,194
 9            9/04/2017 23:16:39.609      0.203         0.000010,572
 10           9/04/2017 23:16:39.812      0.203         0.000015,480
 
Upvote 0
joeu2004 said:
A more reliable method, courtesy of Charles Pearson (click here) [1]....

[1] http://www.cpearson.com/excel/OnTime.aspx

Rich (BB code): 
Private Const n As Long = 10
Private i As Long
Private evtime(0 To n) As Double
Private st(0 To n) As Currency, et(0 To n) As Currency

Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, _
    ByVal nIDEvent As Long) As Long
Private TimerID As Long
Private Const TimerSeconds As Single = 0.2


Private Sub doit()
Dim d As Double, t As Double
Application.StatusBar = "Running...."
DoEvents
QueryPerformanceCounter st(0)
i = 0
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf myevent)
d = Date: t = Timer
If d <> Date Then d = Date: t = Timer    ' race condition
evtime(0) = d + t / 86400
QueryPerformanceCounter et(0)
End Sub


Private Sub myevent()
Dim d As Double, t As Double
QueryPerformanceCounter st(i + 1)
d = Date: t = Timer
If d <> Date Then d = Date: t = Timer    ' race condition
i = i + 1
evtime(i) = d + t / 86400
QueryPerformanceCounter et(i)
If i = n Then
    On Error Resume Next
    KillTimer 0&, TimerID
    Debug.Print vbNewLine & "=========="
    Debug.Print 0, WorksheetFunction.Text(evtime(0), "m/dd/yyyy hh:mm:ss.000"), , _
        Format(convertmytimer(et(0) - st(0)), "0.000000\,000")
    For i = 1 To n
        Debug.Print i, WorksheetFunction.Text(evtime(i), "m/dd/yyyy hh:mm:ss.000"), _
            WorksheetFunction.Text(evtime(i) - evtime(i - 1), ".000"), _
            Format(convertmytimer(et(i) - st(i)), "0.000000\,000")
    Next
    Application.StatusBar = "Done"
    MsgBox "Done"
End If
End Sub


Refer to my previous posting for the code for QueryPerformanceCounter and convertmytimer.

Example run....

Rich (BB code): 
 0            9/04/2017 23:16:37.781                    0.000017,746
 1            9/04/2017 23:16:37.984      0.203         0.000009,439
 2            9/04/2017 23:16:38.187      0.203         0.000010,194
 3            9/04/2017 23:16:38.391      0.203         0.000004,908
 4            9/04/2017 23:16:38.594      0.203         0.000013,970
 5            9/04/2017 23:16:38.797      0.203         0.000011,327
 6            9/04/2017 23:16:39.000      0.203         0.000007,174
 7            9/04/2017 23:16:39.203      0.203         0.000010,194
 8            9/04/2017 23:16:39.406      0.203         0.000010,194
 9            9/04/2017 23:16:39.609      0.203         0.000010,572
 10           9/04/2017 23:16:39.812      0.203         0.000015,480
Click to expand...


Thanks for the info. The 200 ms is not really important. All I want is to mimic a real-time events. I got a function that seek out info. I don't know how to use it using "DDE" so I'm looking to recalculate the targeted cells every few milliseconds

Martin
 
Upvote 0
Hum!!! This warning from "Charles Pearson (click here) [1]...." do represent a problem for me

Warning.png
A NOTE OF CAUTION: If the code executed by the timer changes a cell value, and you are presently in edit mode in Excel (e.g., entering data in a cell), Excel will likely crash completely and you will lose all unsaved work. Use Windows timers with caution.




<tbody>
</tbody>
Click to expand...

I will look for another solution than the timer. The event should not affect the manual entry in others cells or using the sheet to do other task.

Martin
 
Upvote 0
Hi Martin,

Could you describe what it is you are trying to do?

Mark
 
Upvote 0
GTO said:
Hi Martin,

Could you describe what it is you are trying to do?

Mark
Click to expand...

Getting real time price from my broker (Interactive Brokers) of a given instruments. I got a function that I created in vba that do get the price, but I need to refresh it every time to get the latest price. It is not done automatically. Has read, using a timer may cause more damage than what I'm trying to do.

I just found few minutes ago another solution that is using RTD, but for that I need to translate the API in 64 bit file so it can be use with Excel 64.

There is no easy solution...

Martin
 
Upvote 0
mtheriault2000 said:
This warning from "Charles Pearson (click here) [1]...." do represent a problem for me
A NOTE OF CAUTION: If the code executed by the timer changes a cell value, and you are presently in edit mode in Excel (e.g., entering data in a cell), Excel will likely crash completely and you will lose all unsaved work. Use Windows timers with caution.
Click to expand...
Click to expand...

Good eye! That would bother me, as well. Apparently, Windows timers side-step the mechanism that ensures that only one of the Excel and VBA threads runs at a time. And that might explain why the typical OnTime interval is so much longer.
 
Upvote 0
mtheriault2000 said:
... I got a function that I created in vba that do get the price, but I need to refresh it every time to get the latest price. It is not done automatically. Has read, using a timer may cause more damage than what I'm trying to do.
Click to expand...

I am unfamiliar wit RTD or at least am not thinking of what it is an acronym for. Logging out, and may be missing something, but why not store the return in a variable instead of the cell?

Have a good day,

Mark
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Using Sleep function to pause code
Replies
1
Views
478
pujo
P
D
  • Question Question
Pause stopwatch
Replies
8
Views
676
Damian37
D
JeffGrant
  • Question Question
Application.Ontime - just stops
Replies
2
Views
361
JeffGrant
JeffGrant
D
  • Question Question
Calculate number of total rows when new rows are added at given interval
Replies
3
Views
194
dicken
D
corentint
  • Solved
A recursive procedure
Replies
3
Views
347
John_w
J

Forum statistics

Threads
1,224,823
Messages
6,181,170
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top