Problem with Windows Timer API in Excel VBA 2002

If re-running the procedure only once every second is ok for you, you can use Excel's Application.Ontime instead. Like this:

'Declare module level variables
Dim mdtNextTime As Date

Sub StartTimer()
 
  'Just call RunMe - it will execute and set time to re-run every second
  Call RunMe

End Sub

Sub RunMe()
 
  'You can do whatever you like here, of course...
  ActiveCell.Value = Application.Sum(ActiveCell) + 1

  'Set timer to re-run "RunMe" one second from now
  mdtNextTime = Now() + TimeValue("00:00:01")
  Application.OnTime EarliestTime:=mdtNextTime, Procedure:="RunMe", Schedule:=True

End Sub

Sub StopTimer()
 
  'Stop timer
  Application.OnTime EarliestTime:=mdtNextTime, Procedure:="RunMe", Schedule:=False

End Sub

/Ture

Thanks. Unfortunately, I need to get down to within 50 milliseconds. That is why I did not try the Application.Ontime method.

My macro that I posted earlier runs successfully for several hours before aborting. I can't figure out why it is aborting. I have even tried setting the priority to "high" in task manager.

I would guess that your timer events are stepping on one another.  You need to separate the work in a different routine or use a static/global variable to prevent this condition.

Or perhaps if you kill the timer at the beginning of the RunMe procedure and restart the timer at the end of the RunMe procedure.
By doing so, you could be certain that the procedure is finished before it sets the timer to re-execute itself.

ok

The problem you are experiencing is that Excel does not like when a Windows timer pops while it is in a mode that does not allow macros to run - either a cell being edited, a built-in dialog being displayed, including Print Preview, and possibly a macro already running. So there is nothing wrong with your code, just Excel being a stickler for following rules and not being nice when you break them.

There is a solution using a modified pause routine that allows Excel to process UI events. Place the code below in a general module. Put the call to your working routine inside the routine DoTheWork and then run DoTheWork. To stop it press CTRL+ALT+SHIFT. You will find that the loop will continue running and you can still do simple tasks with the workbook. I strongly suggest NOT doing more complex tasks such as running other macros while the loop is active. It might work but I didn't test it to that extent.

[Begin Code Segment]

Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)

Public Enum tKeyCodes
   KeyCodesShift = &H10
   KeyCodesCtrl = &H11
   KeyCodesAlt = &H12
   KeyCodesCapsLock = &H14
   KeyCodesNumLock = &H90
   KeyCodesScrollLock = &H91
End Enum

Private Declare Function GetKeyState Lib "user32" ( _
      ByVal nVirtKey As Long _
   ) As Long
   
Public Sub DoTheWork()

   Do
      Pause 0.5
      ' Replace "Beep" with a call to the routine that does the work every half second
      Beep
   Loop Until IsKeyPressed(KeyCodesCtrl) And IsKeyPressed(KeyCodesAlt) And IsKeyPressed(KeyCodesShift)

End Sub

Public Function IsKeyPressed( _
      ByVal Key As tKeyCodes _
   ) As Boolean
   
' Return True if the requested key is pressed or active, False otherwise.

   Dim Result As Long

   Result = GetKeyState(Key)
   
   ' Toggle keys use the first bit while the others use the 16th bit
   Select Case Key
      Case KeyCodesCapsLock, KeyCodesNumLock, KeyCodesScrollLock
         IsKeyPressed = Result And &H1
      Case Else
         IsKeyPressed = Result And &H8000
   End Select

End Function

Public Sub Pause( _
      ByVal Seconds As Single, _
      Optional ByVal PreventVBEvents As Boolean _
   )

' Pauses for the number of seconds specified. Seconds can be specified down to
' 1/100 of a second. The Windows Sleep routine is called during each cycle to
' give other applications time because, while DoEvents does the same, it does
' not wait and hence the VB loop code consumes more CPU cycles.

   Const MaxSystemSleepInterval = 25 ' milliseconds
   Const MinSystemSleepInterval = 1 ' milliseconds
   
   Dim ResumeTime As Double
   Dim Factor As Long
   Dim SleepDuration As Double
   
   Factor = CLng(24) * 60 * 60
   
   ResumeTime = Int(Now) + (Timer + Seconds) / Factor
   
   Do
      SleepDuration = (ResumeTime - (Int(Now) + Timer / Factor)) * Factor * 1000
      If SleepDuration > MaxSystemSleepInterval Then SleepDuration = MaxSystemSleepInterval
      If SleepDuration < MinSystemSleepInterval Then SleepDuration = MinSystemSleepInterval
      Sleep SleepDuration
      If Not PreventVBEvents Then DoEvents
   Loop Until Int(Now) + Timer / Factor >= ResumeTime
   
End Sub

[End Code Segment]

Kevin

The above code will call your work routine about every half second. If the work routine takes a measurable amount of time to do it's work then the timer will run slower than every half second since it pauses exactly half a second regardless of how long the work routine takes. This may be OK in your environment.

Here is a modified version of the DoTheWork routine that will keep the loop on a precise half second interval for the duration it is running. In other words, each time the Pause function is called, the duration is recalculated to last only until the next half second interval since the last time it was called. It does this by using the Timer VB function which returns the number of seconds since midnight with an accuracy of about 50 MS - the same as the Windows timer function. This version guarantees that in any 100 second period of time the work routine will be called exactly 200 times - unless the work routine consumes more than half a second in which case the next half second interval is skipped.

Public Sub DoTheWork()

   Do
      Pause Application.Max(0, 0.5 - (Timer - Int(Timer / 0.5) * 0.5))
      ' Replace "Beep" with a call to the routine that does the work every half second
      Beep
   Loop Until IsKeyPressed(KeyCodesCtrl) And IsKeyPressed(KeyCodesAlt) And IsKeyPressed(KeyCodesShift)

End Sub

Kevin

Thanks to all for posting solutions. Kevin - a special thanks for the excellent solution. I will try it out tomorrow and let you know if I have any issues. Thanks.

I have done some additional tests. While the loop was running I was able to select cells, edit cells, switch worksheets, save, navigate menus, and show various dialogs without the loop stopping. However, when editing a cell, if the loop tried to set any cell value, it was terminated by Excel and I had to restart it. The workbook didn't crash though. Also, when showing a dialog or print preview, the loop stalled but resumed again when the dialog was closed. When selecting cells the loop is halted until the mouse button is released. Displaying context menus also stalled the loop but did not terminate it.

Kevin

Kevin,

I ran your code and found that the RTD server that is linked to the spread-sheet to bring in real-time data feed for various stock symbols does not update the cells after the DoTheWork procedure is started. The cells update only if I stop it by pressing Cntrl+Alt+Shift. I need to have a continuous feed of real-time data within the spread-sheet, and have a macro running every 0.5 seconds that acts on the updated data for each stock. Is there a way to modify your code to allow data feeds to populate cells?
Thanks again for  your help.

@Kevin

It is best to wait until you are COMPLETELY satisfied with a proposed solution before you accept one or more comments, closing your question.

Sorry, I realize that now.

Unfortunately I don't think that's possible. Excel is preventing the external process from modifying cells while a VBA macro is actively running, even when using the Windows Sleep function and DoEvents.

Can you tell us why you need to read every half second versus every second or longer? If you are getting real-time stock information I do not understand how a half second can make that much difference.

The reason I am asking is because using the Windows timer has a dangerous element when used with a managed interpreted environment like Excel VBA. If we can get way with Application.OnTime you are guaranteed safe operation.

Kevin

I have approximately 500-700 stocks that I monitor on a daily basis. These stocks are in a column on an excel spread-sheet. The RTD server updates these stocks in real-time, and a macro does some simple calculations for all 500-700 rows during each iteration. The macro only does calcuations on the rows where the data has changed. So, even at 0.5 second speed, I am actually losing some of the updates as the data may have changed to another value between two iterations of the macro when there are a lot of updates. In reality, I may never capture all the updates. I was therefore hoping to get to as low as 50 milliseconds with a timer to capture most of the updates. I only chose 0.5 seconds as I found that I was losing a lot more updates with 1 second.

I realize that a suggestion posted earlier by AIKIMARK may be the best I can do: to set a flag to be= true when each macro run is completed, and let the start timer procedure skip an iteration if the flag is = false, i.e. an iteration is in progress and there is collision. This way while I will lose more updates during heavy traffic,  I am at least guaranteed to capture more during lean times when the macro is able to run in less than 0.5 seconds. Your thoughts?

4. Treat the source as a database table and do your update with a single call.

5. Directly link the two workbooks through Excel formulas.

6. Source your target cells from a database query source (can be Excel) and refresh the query.

Note: If you require coordination between user updating actions and code updating, you will need to use a Public/Global bProcessIsActive variable that is also checked by worksheet cell-change events.  

I don't have access to this RTD system so I don't know if this will work but...

If the RTD system is changing values on a sheet why not use the worksheet change event handler? If it's fired by Excel when the cells are modified by the RTD system then you can do your work then. Doing so will capture EVERY change, not just the ones you happen to see when a timer pops. It's also completely safe.

Try this test. Add this code to the code module belonging to the worksheet into which RTD is placing the values. It will generate a beep every time the event is fired. If, while RTD is updating the worksheet, you hear lots of beeps as the RTD system is pushing values into the worksheet then you will have a possible solution.

Private Sub Worksheet_Change(ByVal Target As Range)
   Beep
End Sub

Kevin

I tried this first and realized that change event procedure does not pick up on cell updates by an RTD server. On the other hand, I can use Calculate event. However, this would trigger even when a cell is updated by a macro and not by the RTD server. Also, I need to know which row is being updated as I need to run the macro for that row.

7. Why not keep track of the most recent change timestamp of the RTD?  If you disable automatic calculations, you can compare the last-manual-calc timestamp with the RTD timestamp every 1/2 second and act accordingly.  You may set a flag when the user makes a change and perform the manual calculations at the next 1/2 second timer check.

8. Can your RTD server keep track of the "1" values, independently of the Excel code?  That might add some simplicity and speed to your Excel code.  This is especially important, since VBA code runs at interpreted speed, not compiled speed.

9. What does your Intraday routine do?  This routine's (VBA) performance also affects your overall performance.

10. Can you repackage the Intraday code as Excel formulas?

11. Can you upgrade to VSTO?  .Net code runs at compiled speeds.

Thanks for your suggestions. So far, it appears that your previous solution and Zorvek's solution are equivalent. I am currently testing both to see if the results are different.

The intraday routine is a macro that does simple rowwise computations.
The column with "1" values are created by an excel formula that compares two columns of the same row to see if the data has changed. This is done to skip running the macro on the rows where it is a "0".
The first column is the new price from the RTD server, and the column that is compared is the previous price.

I would like to know more about your new suggestion on upgrading to VSTO. Can you tell me more?
Thanks again.

12. can intraday be changed into multiple Excel formulas?
Yes, at least a good portion of the code can be as it does rowwise computations. I am working on converting the VBA code to excel formulas.

13. can I assume that your intraday routine makes these two columns identical? Yes

15. What kind of "rowwise computations" does intraday do?
It computes ratios of cells; there are several IF...Then..Else statements that computes column values for a given row. Here is a snippet:

Range(PREVFLAG).Value = Range(CONSEC_FLAG).Value
            If Range(STARTSEQUENCE).Value = 1 Then
                If Range(STARTRATE).Value >= 0 And Range(MAXRATE).Value < 0 And Range(DAYRATE).Value < 0 Then
                Range(CONSEC_FLAG).Value = 1
                Else
                Range(CONSEC_FLAG).Value = 0
                Range(CONSEC_TICKS).Value = 0
                Range(TEMPVAL2).Value = 0
                End If
   
                If Range(CONSEC_FLAG).Value = 1 And Range(PREVFLAG).Value = 1 Then
                Range(TEMPVAL2).Value = Range(CONSEC_TICKS).Value
                Range(CONSEC_TICKS).Value = Range(TEMPVAL2).Value + 1
                ElseIf Range(CONSEC_FLAG).Value = 1 And (Range(PREVFLAG).Value = -1 Or Range(PREVFLAG).Value = 0) Then
                Range(CONSEC_TICKS).Value = 1
                Range(TEMPVAL2).Value = 0
                Else
                Range(CONSEC_TICKS).Value = 0
                Range(TEMPVAL2).Value = 0
                End If
               
            End If

Thanks to both Kevin and AIKIMARK. Interestingly, I found that the timer with the flag written by AIKIMARK performed slightly better than the Calculate event procedure. The timer procedure was set at 250 milliseconds. I did the evaluation based on the number of stocks my Intraday program identified for the two procedures. I will try the new calculate event procedure written by Kevin tomorrow, while lowering the milliseconds in the timer further down. Anyway, I am happy with the help I got from both of you. Thank you very much.