CODEWITHSUNDEEP
vbaexcel
EmiPhil
EmiPhil

Reputation: 51

How can I throttle functions in VBA?

I'm making a drop down inside of Excel using a ComboBox and VBA. I have been able to get it to make requests to a remote api, add the returned data to a hidden worksheet, and update the drop down options based on the result of the api.

What I'm looking to do is throttle the api requests. At the moment, it seems that Excel will not fire off the sub if it is already processing an api request. This is not ideal, because often people will type more than one character in rapid succession. I'd like to add a timer to each sub call, and if there hasn't been a new call to the sub function within ~250ms, send the api request. If another call is made during the 250ms, I want to cancel the execution of that sub.

Initially I tried creating a global "process_id" where the sub would add 1 to the current global, set its local id to that value, wait for x time, check if its local id === the global id, and if not exit the sub. However it now seems that the second sub never runs while the timer is waiting for x time, so the first sub still runs, just x seconds later (and the second sub never runs at all).

How do I go about throttling sub functions in Excel VBA so that the same sub function can be run while the first is waiting?

Upvotes: 2

Views: 800

Answers (3)

Tim Williams
Tim Williams

Reputation: 166685

I think what you're really looking for is "don't call the API until I've stopped typing" (i.e. when no further key press has occurred within x msec of the previous one).

If that's what you want then this (with hat tip to @Tragamor's answer) should do it. This is much closer to what you might do in js using window.setTimeout for example.

In a regular code module:

Option Explicit

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

'this function called from the control's Change event
Function CallApi()
    Const DelayMsec As Long = 500
    If TimerID > 0 Then KillTimer 0&, TimerID 'kill any existing timer
    TimerID = SetTimer(0&, 0&, DelayMsec, AddressOf CallApi2) 'set a timer
End Function

'this function called from the timer
Sub CallApi2()
    If TimerID > 0 Then KillTimer 0&, TimerID
    Debug.Print "Calling API with '" & Sheet1.TextBox1.Text & "'"
End Sub

Upvotes: 1

Tragamor
Tragamor

Reputation: 3634

As stated; you require an asynchronous timer with millisecond precision

Hopefully the following should work for you:

While the timer is set, no further timer should be set and when the timer fires the event, the timer stops itself so multiple calls during the 'DelayTimeSeconds' period should only result in one call to the API

' Adapted from https://groups.google.com/forum/?hl=en#!topic/microsoft.public.excel.programming/Ce--7sympZM
' These procedures require that you are using Office 2000 or later, because of the AddressOf function

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 AllowFireTime As Single
Private TimerID As Long
Private TimerSeconds As Single
Private TimerSet As Boolean

Const DelayTimeSeconds As Single = 0.75

Sub TestFireDelay()
    CallAPIProc
End Sub

Private Function CallAPIProc()
    Dim NowTime As Single: NowTime = Timer
    If AllowFireTime > NowTime Then
        If TimerSet = False Then StartTimer AllowFireTime - NowTime
    Else
        AllowFireTime = NowTime + DelayTimeSeconds

        Call TestCall
        ' Code for API Call

    End If
End Function

Function StartTimer(Optional TimerSeconds = 1) ' how often to "pop" the timer.
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
    TimerSet = True
End Function

Function EndTimer()
    On Error Resume Next
    KillTimer 0&, TimerID
    TimerSet = False
End Function

Function TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
    ' The procedure is called by Windows. Put your timer-related code here.
    '
    Call EndTimer
    Call CallAPIProc
End Function

Function TestCall()
    Debug.Print Format(Now, "hh:mm:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)
End Function

Upvotes: 1

K.Dᴀᴠɪs
K.Dᴀᴠɪs

Reputation: 10139

Sticking with your method of using global variables, keep one to track the Timer function. Unfortunately you did not provide your code, so I can only make assumptions on how you should implement this.

Private myTimer As Single   '// Global Variable, outside of any routine

Sub foo()               

    If Timer - myTimer < 0.25 Then Exit Sub

    callMyAPI
    myTimer = Timer

End Sub

If you prefer not to exit the sub, wrap the API call in an If statement. 

Private myTimer As Single

Sub foo()

    ' Non-API related code

    If Timer - myTimer > 0.25 Then
        callMyAPI
        myTimer = Timer
    End If

    'Non-API related code

End Sub

With each API call, you will reset the myTimer variable.

Upvotes: 0

Related Questions