VBA Function to Calculate API calls in second workbook - excel

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

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

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

Related

select multiple sheets for printing at once

I'm trying to write code to have several Sheets in a file printed in one print job.
The Sheets to be printed are created dynamically; their names and the number of sheets differ each time, but I know that I want to print all sheets in the workbook apart from Keep1 and Keep2 (In real 7 different sheet names).
The reason I want to print all sheets in one job is that it could be many sheets, and this would mean a long wait and lots of print job pop-ups.
To realize the above, I thought of creating a selection of the sheets I want to print and then order to print.
I wrote the following:
Sub printtest()
Dim arr As Variant, sht As Worksheet
arr = Array("Keep1", "Keep2")
Application.DisplayAlerts = False
For Each sht In ThisWorkbook.Worksheets
If Not UBound(Filter(arr, sht.Name, True, vbtruecompare)) >= 0 Then
With sht.PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
sht.Select False
End If
Next sht
SelectedSheets.PrintOut
Application.DisplayAlerts = True
End Sub
After running the code, I run into the following:
sht.Select False adds up each Sheet meeting the conditions to the current selection, but since the button is on active sheet Keep1 this sheet is part of the selection (and should not be):
The .FitToPagesWide = 1 is performed for each Sheet in the selection, but .FitToPagesTall is also set to 1 (I want to keep this as Automatic, but don't know how to.
I don't know how to reference the selection in my print job properly.
I tried:
sht.PrintOut which results in Run-time error 91 (Object variable or With block variable not set).
SelectedSheets.PrintOut which results ion Run-time error 424 (Object required).
My vba knowledge is limited and I can't find a way to reference the selected pages for the printout.
Thanks for looking into this and explaining what is wrong in this approach.
Print Multiple Worksheets
You rarely need to select anything which is shown in the following code.
It writes the worksheet names to the keys of a dictionary, which are actually an array, and uses this array (the keys) to reference the worksheets to be printed.
Sub PrintTest()
Dim Exceptions() As Variant: Exceptions = Array("Keep1", "Keep2")
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, Exceptions, 0)) Then
With ws.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 2
End With
dict.Add ws.Name, Empty
End If
Next ws
ThisWorkbook.Worksheets(dict.Keys).PrintOut
Application.DisplayAlerts = True
End Sub
You could try to make a string with only the worksheet names you want, excluding Keep1 and Keep2. Then take that string into an unidimensional array and use that array as your selection of worksheets:
Dim wk As Worksheet
Dim StringWk As String
Dim ArrayWk As Variant
'string of wk names
For Each wk In ThisWorkbook.Worksheets
If wk.Name <> "Keep1" And wk.Name <> "Keep2" Then StringWk = StringWk & wk.Name & "|"
Next wk
StringWk = Left(StringWk, Len(StringWk) - 1) 'clean last | delimiter in string
ArrayWk = Split(StringWk, "|")
Sheets(ArrayWk).Select
'code to print to pdf or whatever
'
'
'
'
'
Sheets("Keep1").Select 'deactivate selection
Erase ArrayWk
To create the array we use SPLIT:
Split
function

Delete multiple Excel Sheets in VBA

I am using an excel Workbook for programtical generation. Once the workbook is created few of the sheets are having required data and few are blank with default templates only.
I need to delete all sheets having default templates (means no data). I can check specific cell to identify this however need to know how to check for all sheets and then delete sheets one by one.
I am having this piece of code:
Sub TestCellA1()
'Test if the value is cell D22 is blank/empty
If IsEmpty(Range("D22").Value) = True Then
MsgBox "Cell A1 is empty"
End If
End Sub
Try this:
Sub DeleteEmptySheets()
Dim i As Long, ws As Worksheet
' we don't want alerts about confirmation of deleting of worksheet
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
Set ws = Worksheets(i)
' check if cell D22 is empty
If IsEmpty(ws.Range("D22")) Then
Sheets(i).Delete
End If
Next
' turn alerts back on
Application.DisplayAlerts = True
End Sub
An alternative implementation using For-Each:
Sub deleteSheets()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = Workbooks("Name of your Workbook")
'Set wb = ThisWorkbook You can use this if the code is in the workbook you want to work with
Application.DisplayAlerts = False 'skip the warning message, the sheets will be deleted without confirmation by the user.
For Each sht In wb.Worksheets
If IsEmpty(sht.Range("D22")) And wb.Worksheets.Count > 1 then
sht.Delete
End If
Next sht
Application.DisplayAlerts = True
End Sub
This mainly serves as a demonstration pf how you can easily loop through worksheets.
As suggested in the comments below by #Darren Bartrup-Cook , the logic according to which the sheets are deleted can and should be modified to not only suit your purposes but to also include safeguards.
Making sure there's always at least one worksheet in the workbook is one of them. This can be ensured in a multitude of ways. I updated my answer to implement one these.

Close and save workbook via macro without running 'beforesave' events

I have a list of workbooks that follow the same template, and all have a macro 'beforesave' event, which basically creates a save-log in on of the sheets, listing the time and user id from whoever is saving the workbook.
So sometimes I need to change a formula in all workbooks, and since it takes around a minute to close and save each of them manually, I created a macro that opens all of them changes what I need changed, and closes saving them. That would save me some significant amount of time, as on total this process ends up taking around 30 mins of my time, and a lot of boredom.
Problem is: when the macro tries to close and save the workbook, the 'beforesave' event doesn't run properly and as a result the workbook doesn't save and close with the macro. For some reason, the event seems to be skipped in the macro...
To solve that I want to run this macro to make all the changes in all workbooks, skipping the beforesave event (if necessary) and actually saving and close them at the end.
Help please?
Tried running the macro line by line, and when it gets to the event part, it calls it, but for some reason it stays in the same sheet instead of going to the log sheet, and writes the log info in the wrong sheet as a result. In any case, running line by line won't obviously work for me as it's basically the same as doing the process myself, manually.
Sub DoStuff()
Dim Row As Integer
Dim Col As Integer
Dim wbCopy As Workbook
Dim wbPaste As Workbook
Dim wbBP As Workbook
For Col = 4 To 4
ThisWorkbook.Activate
Set wbBP = Workbooks.Open(Cells(1, Col), False)
ThisWorkbook.Activate
Set wbCopy = Workbooks.Open(Cells(2, Col), False, True)
For Row = 3 To 19
ThisWorkbook.Activate
SetAttr Cells(Row, Col), vbNormal
Set wbPaste = Workbooks.Open(Cells(Row, Col), False)
wbCopy.Activate
Sheets("Base").Activate
Range("A7:EQ500").AutoFilter
wbPaste.Activate
Sheets("Base").Activate
Range("A7:EQ500").AutoFilter
wbCopy.Activate
Sheets("Base").Activate
Range("AL8:AS8").Copy
wbPaste.Activate
Sheets("Base").Activate
Range("AL8:AS" & Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
wbPaste.Close True
ThisWorkbook.Activate
SetAttr Cells(Row, Col), vbReadOnly
Next Row
wbCopy.Close False
wbBP.Close False
Next Col
End Sub
Running the macro to do the changes I need, and having all workbooks involved saved and closed properly.
Welcome to SO. The answer to the title is too simple if you are OK to execute your update job running any events in the wbPaste workbooks. Just simply adding Application.EnableEvents = False before the saving the file and make it true after the save completion.
Also based on the points commented by #Mathieu Guindon your post is confusing about your exact requirement and the inadvertent use of Activate I just restructured your code a little to avoid running any events during update.
Sub DoStuff()
Dim Row As Integer
Dim Col As Integer
Dim wbCopy As Workbook
Dim wbPaste As Workbook
Dim wbBP As Workbook
‘Worksheet name “FileList” used for trial . May please change to yours or use activesheet
With ThisWorkbook.Worksheets("FileList")
For Col = 4 To 4
‘Could not understand why wbBP opened, it is not used anywhere in the code
Set wbBP = Workbooks.Open(.Cells(1, Col), False)
Set wbCopy = Workbooks.Open(.Cells(2, Col), False, True)
‘ This will disable any events including ‘BeforeSave’ events
Application.EnableEvents = False
‘Disabling ScreenUpdating will increase efficiency if large files used
Application.ScreenUpdating = False
For Row = 3 To 19
SetAttr .Cells(Row, Col), vbNormal ‘ failed to understand use of SetAttr
Set wbPaste = Workbooks.Open(.Cells(Row, Col), False)
wbCopy.Sheets("Base").Range("A7:EQ500").AutoFilter
wbPaste.Sheets("Base").Range("A7:EQ500").AutoFilter
wbCopy.Sheets("Base").Range("AL8:AS8").Copy
wbPaste.Sheets("Base").Range("AL8:AS" & Cells(Rows.Count , 1).End(xlUp).Row).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
wbPaste.Close True
SetAttr .Cells(Row, Col), vbReadOnly
Next Row
Application.EnableEvents = True
Application.ScreenUpdating = True
wbCopy.Close False
wbBP.Close False
Next Col
End With
End Sub
If you want to run other events in the wbPaste workbooks and only intend to avoid running only BeforeSave events or a part of code in that event and you have access to modify the event codes, then you may resort to introduce a branch in the `BeforeSave’ events code by checking value of cell as per my comment. If apprehensive about cell value being accidentally modified/deleted by user, it is better to introduce check a ‘CustomDocumentProperties’
You may opt to add & set the custom Document Property from document panel of all the wbPaste workbooks. I would prefer to introduce the Custom Document Property BeforeSaveCheck‘ by onetime running the code
Sub testOnce()
Dim Row As Integer
Dim Col As Integer
Dim wbPaste As Workbook
Col = 4
With ThisWorkbook.Worksheets("FileList")
Application.EnableEvents = False
'Application.ScreenUpdating = False
For Row = 3 To 19
SetAttr .Cells(Row, Col), vbNormal
Set wbPaste = Workbooks.Open(.Cells(Row, Col), False)
wbPaste.CustomDocumentProperties.Add Name:="BeforeSaveCheck", LinkToContent:=False, Type:=msoPropertyTypeBoolean, Value:=True
wbPaste.Close True
SetAttr .Cells(Row, Col), vbReadOnly
Next Row
Application.EnableEvents = True
'Application.ScreenUpdating = True
End With
End Sub
Now you may introduce the a simple branch in BeforeSave events of wbPaste workbooks like
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If ThisWorkbook.CustomDocumentProperties("BeforeSaveCheck") Then
‘’’’’’’’’’’’’
‘The code section you want to bypass while updating with macro
‘’’’’’’’’’’’
End If
End Sub
and setting the property to True at the open event
Private Sub Workbook_Open()
ThisWorkbook.CustomDocumentProperties("BeforeSaveCheck") = True
End Sub
Finally in sub dostuff
Delete lines
Application.EnableEvents = False
Application.EnableEvents = True
And add line
ThisWorkbook.CustomDocumentProperties("BeforeSaveCheck") = False
wbPaste.Close True

Two workbooks, Same Sheets Names: Copy and Paste if Sheets are matched

I have two workbooks, with same sheets name (but in different order), and I'd like to copy info of all of the sheets of one workbook, and pasting that info in the respective sheet of the other workbook (matching sheet names). I feel like this code is on track, but maybe there is a more efficient or cleaner way to do this. Code is working, but it says a warning like " there's a big amount of data in the windows clipboard... etc... "
Sub ActualizarNoticias()
Dim aw As Workbook
Dim y As Workbook
Set aw = Application.ActiveWorkbook
Set y = Application.Workbooks.Open("G:\Estudios\Biblioteca\Mercado Accionario Chileno\BBDD Oficial.xlsm")
For i = 1 To aw.Sheets.Count
For j = 1 To y.Sheets.Count
If aw.Worksheets(i).Name = y.Worksheets(j).Name Then
y.Worksheets(j).Range("A3").Copy
aw.Worksheets(i).Range("A100").PasteSpecial
End If
Next j
Next i
y.close
' ActualizarNoticias Macro
'
'
End Sub
I am not sure how much data you intend to copy, or where in the target workbook you want to copy to, but the code you posted only copies one cell (A3) and copies it into the target workbook in cell A100. I gather your code is only an example, because surely the warning would not come for copying a single cell. It would help to have your actual ranges, and exact warning message, but as you said, it's working. Are you getting the message when you run the code, or when you exit the workbook? If the latter (as I suspect), then you can simply clear the clipboard at the end of your code:
Application.CutCopyMode = False
You can also eliminate the second loop with a little trickery:
Set sh = Nothing
On Error Resume Next
Set sh = y.Worksheets(aw.Worksheets(i).Name)
On Error GoTo 0
If TypeName(sh) <> "Nothing" Then
....
End If
My entire subroutine looks as follows:
Sub CopyWorkbook()
Dim aw As Workbook
Dim y As Workbook
Dim sh As Worksheet
Set aw = Application.ActiveWorkbook
Set y = Application.Workbooks.Open("C:\work\fusion\expenseTypes.xls.xlsx")
For i = 1 To aw.Sheets.Count
Set sh = Nothing
On Error Resume Next
Set sh = y.Worksheets(aw.Worksheets(i).Name)
On Error GoTo 0
If TypeName(sh) <> "Nothing" Then
sh.Range("A:C").Copy aw.Worksheets(i).Range("A1")
End If
Next i
Application.CutCopyMode = False
End Sub
I think this is the most efficient way to do it. My sample code above copies entire columns (A through C), which preserves column formatting, so that it's not necessary to re-adjust your new workbook for the column widths.

How can I get my userform to select it's droplist data from a separate worksheet?

I have a userform that fills out a row of information into an excel sheet. The excel sheet has two spreadsheets, one for data entry, and one for the 3 droplists that are in the userform. I want to delete this second sheet and make it into its own workbook. My question here is how can I write the VBA code to select the data from the droplist workbook (called "Client and Project Droplists.xlsx") to populate the droplists in the userform in the first workbook (called "Expense Reports Test.xlsm")? My current code is attached below.
Private Sub cboClient_Change()
Me.cboProject = ""
Select Case Me.cboClient
Case "Wells Fargo"
Me.cboProject.RowSource = "WellsFargoProjects"
Case "BLUSA"
Me.cboProject.RowSource = "BLUSAProjects"
Case "JP Morgan"
Me.cboProject.RowSource = "JPMProjects"
End Select
End Sub
I will be at work for the next few hours so any additional information can be requested in the questions/comments section. Would really appreciate help on this task.
My co-worker and I share a lot of data and work in excel quite a bit, so we have created quite a few shared tables on network drives for use in our utilities.
One method we have employed is opening a global list, copying it locally, and using it to populate a dropdown:
Sub GetStatusCodeList()
Dim ThisWb
Set ThisWb = ThisWorkbook
If Dir("\\SERVERNAME\GlobalUtilities\GlobalTables.xlsx") = "" Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Open "\\SERVERNAME\GlobalUtilities\GlobalTables.xlsx", ReadOnly:=True
ActiveWorkbook.Sheets("GlobalTables").UsedRange.Copy ThisWb.Sheets("DropDown").Range("A1")
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
Another method simply reads the cells from a global list and writes them directly into the conditional formatting list. This particular code creates an array of available sheets and uses it to populate a dropdown:
Sub CreateSheetDropdown()
Dim sheetCounter, i
Dim theSheets() As String
ReDim theSheets(ActiveWorkbook.Sheets.Count + 1) As String
For i = 1 To ActiveWorkbook.Sheets.Count
theSheets(i) = ActiveWorkbook.Sheets(i).Name
Next i
With ThisWb.Sheets(Mtab).Range("SourceTabName")
.Value = theSheets(1)
.Validation.Delete
'.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
' Operator:=xlBetween, Formula1:=Join(theSheets, ",")
.Validation.Add Type:=xlValidateList, Operator:=xlBetween, Formula1:=Join(theSheets, ",")
.Validation.ShowError = False
.Interior.color = RGB(250, 200, 200)
End With
End Sub
Finally, this code creates a dropdown in a userform from a global list that we keep on our shared drive:
Private Sub UpdateDropdowns()
Dim thisWorkbook
Set thisWorkbook = ActiveWorkbook
If Dir(TABLEPATH) = "" Then
MsgBox ("GlobalTables File Not Found - Critical Error")
Me.Hide
Exit Sub
End If
Workbooks.Open Filename:=TABLEPATH, ReadOnly:=True
'---------------------------------------------
'Method would load from GlobalTables.xlsx
'---------------------------------------------
'Load Utility Names
For Each c In ActiveWorkbook.Sheets(UTIL_SHEET).Range("A2:A" & ActiveWorkbook.Sheets(UTIL_SHEET).Cells(ActiveWorkbook.Sheets(UTIL_SHEET).Rows.Count, "A").End(xlUp).row).Cells
AddUtilToAll (c.Value)
Next c
End Sub
Private Sub AddUtilToAll(ByVal s)
For Each c In Me.Controls
If InStr(c.Name, "UtilityCombo") Then c.AddItem (s)
Next c
End Sub
Probably the easiest method to employ is the first one - just open the workbook stored on a shared drive and copy each dropdown list locally. You can run this in the Worksheet initialize function so that the dropdowns are updated each time you open the file.
Hope this helps, let me know if you want more information.
Edit:
It's probably easier to read here.
Just link your dropdown to a named range:
'Delete the old named range
ThisWorkbook.Names("TestDropdown").Delete
'Define the new named range
ThisWorkbook.Names.Add Name:="TestDropdown", RefersTo:=Range("A1:A25")

Resources