Scenario: I have two workbooks, one of them contains VBA (WB1) code and the other (WB2) contains calls to an API for data collection (e.g. Bloomberg Add in function). When the code in WB1 is run, it starts a loop of identifiers, for each, it opens an instance of WB2, and tries to recalculate all functions. Once that is done, it copies some of the data of WB2 to WB1, saves WB2 with the identifier name, closes it and moves on to the next identifier.
Issue: As each of the API calls in WB2 take some time to process ad retrieve data, the VBA script does not wait for the functions to be calculated, it just copies the same data and moves on in the loop. Consequently, the data copied to WB1 is incorrect.
What was tried so far: I used a series of Calculate commands in VBA, also used loops to with DoEvents and tried to set up a counter in WB2 with the number of cells with data still pending calculation. In all these cases, the functions are still not fully calculated.
Obs. In this case, as this is not a specific problem to a single API (e.g. Bloomberg) the solution needs to come from a VBA command in the script of WB1.
Code so far:
Private Sub DownloadData()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
' clear raw data sheets
Dim mainwb As Workbook
Set mainwb = ThisWorkbook
ThisWorkbook.Worksheets(wsRawClassData.Name).UsedRange.ClearContents
Dim wsas As Variant
wsas = Evaluate(ThisWorkbook.Names("WSATickers").Value)
' path
Dim xlsPath As String
xlsPath = Evaluate(ThisWorkbook.Names("Path").Value)
If xlsPath = "" Then
xlsPath = ThisWorkbook.Path
End If
Dim c As Integer
For c = 1 To 100
If wsas(c, 1) = "" Then Exit For
Dim objXL
Set objXL = CreateObject("Excel.Application")
Dim objXLWB
Set objXLWB = Workbooks.Open(xlsPath & "WB2.xlsm")
objXLWB.Worksheets("Data").Range("Identifier").Value = wsas(c, 1)
Application.Calculation = xlManual
Application.Calculation = xlAutomatic
'wait for initial calculations
Do While objXL.CalculationState <> xlDone
DoEvents
Loop
' Recalculation forcing:
objXLWB.Activate
Application.Calculation = xlManual
Application.Calculation = xlAutomatic
Application.CalculateFull
Application.Calculation = xlAutomatic
Dim wsobj As Variant
For Each wsobj In objXLWB.Worksheets
wsobj.Calculate
Do While objXLWB.Worksheets("Data").Range("calcpend").Value <> 0
Application.Wait (Now TimeValue("0:00:02"))
Loop
Next wsobj
Application.Calculation = xlAutomatic
mainwb.Activate
Do Until objXLWB.Worksheets("Data").Range("calcpend").Value = 0
DoEvents
Loop
ThisWorkbook.Worksheets(wsRawData.Name).Range("A" & (c 1)).Value = wsas(c, 1)
' save, close, quit
objXLWB.SaveAs Filename:=xlsPath & wsas(c, 1) & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
objXLWB.Close
objXL.Quit
Next c
End Sub
CodePudding user response：
It has been a while (like 20 years) since I worked with VBA and Bloomberg, but as I recall, you can make calls to the Bloomberg API directly from VBA. A quick google search of "call bloomberg api from vba" led me to this page that seems promising:
https://github.com/tebbb/VBA-Bloomberg-API-Wrapper
CodePudding user response：
The solution below takes the following approach.
- make a copy of the formulas in all the cells you need to wait on
- clear those cells so their values are empty strings
- replace the formulas causing them to need to be recalculated
- use application.onTime to check every second to see if all formulas have received values
This approach assumes that the formulas that rely on add-ins to fetch data will return not return a value until they have received thier data. If this is not true, you'll need to adjust the code accordingly.
I think the key making this work for you is the use of application.onTime becuase that allows all VBA to finish running which seems to be important to allow the data to be fully retrieved.
Option Explicit
Dim formulas As New Collection
Sub wait_until_filled()
Dim x As Long
Dim range_to_check As range
Dim sheet_to_check As Worksheet
Dim workbook_to_check
Dim cell As range
' specify the workbook that holds the formulas that we want to check
Set workbook_to_check = Workbooks("Book3.xlsx")
' specify the sheet that holds the formulas that we want to check
Set sheet_to_check = workbook_to_check.Worksheets("Sheet1")
' specify the set of cells that contain the formulas we are waiting for.
Set range_to_check = sheet_to_check.range("D1:D2,E1")
' clear out old formulas in case we have had a prior run
Do Until formulas.Count = 0
formulas.Remove 1
Loop
' remember each formula, then clear it
For Each cell In range_to_check
formulas.Add Array(workbook_to_check.Name, sheet_to_check.Name, cell.Address, cell.Formula)
cell.Formula = ""
Next
' replace the formulas, causing them to recalculate
For x = 1 To formulas.Count
Workbooks(formulas(x)(0)).Worksheets(formulas(x)(1)).range(formulas(x)(2)).Formula = formulas(x)(3)
Next
'wait a second then call the sub that checks to see if the data has returned
Application.OnTime DateAdd("s", 1, Now), "wait_for_data"
End Sub
Sub wait_for_data()
Dim x As Long
'check to see of all formulas have a value
For x = 1 To formulas.Count
' this if statement assumes that a formula that relies on an addin will produce
' a blank value until it has been filled in, which may not be true.
If Workbooks(formulas(x)(0)).Worksheets(formulas(x)(1)).range(formulas(x)(2)).Value = "" Then
'we have found a cell that has not updated, check again in another second
Application.OnTime DateAdd("s", 1, Now), "wait_for_data"
Exit Sub
End If
Next
' put code here to execute once all cells have received thier values
MsgBox "all cells have received thier values"
End Sub