Spacing out a batch Find/Replace so that it proceeds in smaller 'chunks'

[d0rian]

The server I'm pulling stock quotes from has added a request-limit of 50 quote-requests / second; if you request more than that, it disconnects you. My current code requests 500 at once, so I need to revise it so that it spaces out those requests over 10 seconds.

The way the formulas are 'activated' in the code below is by replacing the '$' at the start of the string with a '=' so that Excel converts it to a formula (which sends the quote-request). Each row (from 43 to 452) has the formulas for one stock quote. As you can see below, I currently just do a batch Find/Replace for all 500 rows (D43:S452) at once, but I need it to do it in batches of 50 (e.g. D43:S92), then pause 1.25 seconds, then do it for the next batch (D93:S142), and so on.

Sub     
    Application.ScreenUpdating = False
    With Sheets("Kitty")
        With .Range("D43:S452")
                    .Replace What:="#", Replacement:="=", LookAt:=xlPart, _
                        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                        ReplaceFormat:=False
        End With
    End With
    Application.ScreenUpdating = True
    Application.CutCopyMode = False


End Sub

 

[tonyyy]

d0rian,

You might consider the following...

Sub stockQuotes_1026992()
Application.ScreenUpdating = False
Dim i As Long

Do
    With Sheets("Kitty")
        With .Range(Cells(43 + i, 4), Cells(92 + i, 19))
            .Replace What:="#", Replacement:="=", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
        End With
    End With
    Application.Wait Now + TimeSerial(0, 0, 1) + TimeSerial(0, 0, 1) / 4
    i = i + 50
    If i > 400 Then Exit Do
Loop

Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Cheers,

tonyyy

 

[shg]

I think Wait has a precision of 1 second.

Sub d0rian()
  Dim iRow          As Long
  Dim fT            As Single   ' time
  Dim fD            As Single   ' delta time

  With Worksheets("Kitty")
    For iRow = 43 To 452 Step 50
      Rows(iRow).Range("D1:S1").Resize(50).Replace "#", "="

      fT = Timer
      Do
        fD = Timer - fT
        If fD < 0! Then fD = fD + 86400!
      Loop While fD <= 1.25!
    Beep
    Next iRow
  End With
End Sub

 

[tonyyy]

I think Wait has a precision of 1 second.

hmmm... I don't think so. If you run the test below, you'll get 4 seconds - as expected. Then comment out the first .Wait and uncomment the second .Wait and you get 6 seconds - again as expected.

Sub WaitTest()
Dim i As Long
Dim s1 As Date, s2 As Date
s1 = Now
    
For i = 1 To 4
    Application.Wait Now + TimeSerial(0, 0, 1)
'    Application.Wait Now + TimeSerial(0, 0, 1) + TimeSerial(0, 0, 1) / 2
Next i

s2 = Now
MsgBox s1 & vbCrLf & s2
End Sub

 

[shg]

Right -- but the request was for 1.25 seconds.

 

[tonyyy]

Yes, that's why the code in post #2 has the line...

Application.Wait Now + TimeSerial(0, 0, 1) + TimeSerial(0, 0, 1) / 4

 

[shg]

Yes, that's why the code in post #2 has the line...

That's the post I was referring to, tonyy; it doesn't work as you expect. Try running this:

Sub t()
  Dim i             As Long
  Dim f             As Single

  For i = 1 To 10
    f = Timer
    Application.Wait Now + TimeSerial(0, 0, 1) + TimeSerial(0, 0, 1) / 4
    Debug.Print Timer - f
  Next i
End Sub

What do you see in the Immediate window?

 

[shg]

In post#3,

Rows(iRow).Range("D1:S1").Resize(50).Replace "#", "="

should be

.Rows(iRow).Range("D1:S1").Resize(50).Replace "#", "="

 

[d0rian]

Thank you both for your replies -- I ran into an unexpected obstacle, though: It appears that VBA macros demand exclusive focus, and don't let ANY of the RTD quote-requests go out until the macro has finished running in its entirety. The result is that all RTD messages are getting 'held' until the code runs in its entirety, after which they all get sent at once (the very thing I'm trying to avoid). E.g.:

Sub sun_6_loop()Dim i As Integer
i = 1


Do Until i > 12
    Range("J" & Range("X2").Value, "V" & Range("Y2").Value).Select
    Selection.ClearContents
    Application.Wait Now + #12:00:02 AM#
    i = i + 1
Loop

That J&(X2) , V&(Y2) range is a dynamic reference to batches of 50 rows, so the above I *thought* would neatly delete 50 quotes at a time (which sends 50 RTD messages), wait 2 seconds, then delete another 50, and loop 12 times. When I run the above, I watch as 50 rows indeed get deleted every 2 seconds, BUT the RTD messages are being prevented from being sent out until the entire 12 loops run, whereupon all 500+ are sent at once and I get booted from the server.

I can remove the 'Loop', and manually run the above 12 times, but want to avoid that, obviously. Can any of the VBA 'timing' / 'delay' functions be written so as to allow the RTD messages out incrementally while the code's being run?

 

[d0rian]

BTW, I had another thought about solving this problem that i asked in this post, but might it be possible -- instead of trying to tweak the VBA to only do batches of 50 at once -- to perhaps instead change a global RTD setting (if one even exists) that regulates the max pace of RTD messages that can be sent out? In other words, some kind of direction that says to Excel "Even if you get a huge batch of RTD messages, e.g. several hundred, at once, I want you to QUEUE them up, but only release them at a rate of 50 / second? That's probably too much to hope from Excel, but didn't think it was the craziest thought.