I have the following code refreshing 1 or 2 queries, depending:
Sub RefreshPowerQueries()
Dim WB As Workbook
Dim startTime As Single
startTime = Timer
Set WB = ThisWorkbook
Application.Calculate
If WB.Names("One_Or_Two_Queries_Boolean").RefersToRange.Value2 Then
WB.Connections("Query - 1").Refresh
WB.Connections("Query - 2").Refresh
shIndiv.UsedRange.Columns.AutoFit
shIndiv.Columns("Z").Hidden = True
Else
WB.Connections("Query - 3").Refresh
shIndiv2.UsedRange.Columns.AutoFit
shIndiv2.Columns("Z").Hidden = True
shIndiv2.Select
End If
MsgBox "Load Time: " & Format((Timer - startTime) / 86400, "hh:mm:ss")
End Sub
When it goes through the Else part of the statement, it waits until the table is full refreshed, then properly re-aligns everything, then generates how long it took. Great, it works perfectly (And takes ~6 seconds).
However, when I go through the True portion of the IF, it takes about 1 second to run, but the queries aren't done updating. It'll then have the queries refreshing in the background, and after some time, they'll refresh - after the resize portion is done.
Why is this happening? Is there any way to force the queries to finish refreshing before continuing on?
Thank you
Related
I have a heavy model calculating c.310 financial data for c.12.000 companies. The initial data is retrieved from the S&P Capital IQ online database through an Excel add-in which requires calculation to be on semi-automatic or automatic mode to update.
Multithread calculation to update all formulae at once makes the model crash and up to this point I can only update it by taking each column individually and manually update them (and then copy/paste values) without macro to have the multithreading computation.
To automate the process, I created a macro that takes each of the 310 columns individually, copy/pastes the formula for all companies, calculates the selection only and then pastes in values before proceeding to the next column.
But VBA being in singlethread calculation and the add-in requiring calculation mode to be in semi-automatic, the macro still takes over 8h to update the whole model as for each column update, the macro has to update the whole sheet everytime.
For the update to go faster, I would need either a way to allow VBA multithreading (but seems complex to do), or to find a way to have Calculation Mode on Automatic for only one column at a time, so that VBA does not update the whole worksheet everytime.
Do you have any idea if this would be possible and how ?
Thank you very much for your help!
Here is the structure of the current VBA code (one section out of 8) :
My sincere apologies if this code is far from optimised, I am self taught in VBA.
All named ranges below are mostly meant to identify a column/row number that can change depending on how many companies I want to analyse.
FONDA is the Excel worksheet.
Sub Update()
'==============================================================
'INITIALISATION
Dim FirstRow As Integer, LastRow As Integer, i As Integer, Errors
As Integer
Dim Progress As Double, ProgressPercentage As Double, BarWidth As
Long, Steps As Integer, CurrentProgress As Double
Dim StartTime As Double, MinutesElapsed As String
StartTime = Timer
Steps = 312
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.CalculateBeforeSave = False
Call InitProgressBar
FONDA.Select
Range("FONDA_FIRSTROW").Calculate
FirstRow = Range("FONDA_FIRSTROW").Value
Range("FONDA_LASTROW").Calculate
LastRow = Range("FONDA_LASTROW").Value
Range("FONDA_UPDATECHECK").ClearContents
Range(Cells(Range("FONDA_FIRSTROW").Value,
Range("Section_A_D").Column), Cells(Range("FONDA_LASTROW").Value,
Range("Section_B_F").Column)).ClearContents
CurrentProgress = Progress / Steps
ProgressPercentage = Round(CurrentProgress * 100, 1)
BarWidth = ProgressIndicator.Border.Width * CurrentProgress
ProgressIndicator.Bar.Width = BarWidth
ProgressIndicator.Text.Caption = "Calculation : " &
ProgressPercentage & "%"
DoEvents
'==============================================================
'SECTION A
'Update from left to right
For i = 1 To Range("Section_A_ColumnCounter").Value
Application.Calculation = xlCalculationManual
Cells(Range("FONDA_FORMULAROW").Value, Range("Section_A_D").Column
+ i - 1).Copy
Range(Cells(Range("FONDA_FIRSTROW").Value,
Range("Section_A_D").Column + i - 1),
Cells(Range("FONDA_LASTROW").Value, Range("Section_A_D").Column + i
- 1)).PasteSpecial Paste:=xlPasteFormulas
Application.Calculation = xlCalculationSemiautomatic
ActiveSheet.Calculate
'Application.Wait (5)
'Do Until Application.CalculationState = xlDone
'DoEvents
'Loop
Application.Calculation = xlCalculationManual
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Cells(Range("FONDA_ERRORCOUNTER").Value,
Range("Section_A_D").Column + i - 1).Calculate
Errors = Cells(Range("FONDA_ERRORCOUNTER").Value,
Range("Section_A_D").Column + i - 1).Value
If Errors = 0 Then
Cells(Range("FONDA_UPDATECHECK").Row,
Range("Section_A_D").Column + i - 1).Value = 1
Progress = Progress + 1
End If
CurrentProgress = Progress / Steps
ProgressPercentage = Round(CurrentProgress * 100, 1)
BarWidth = ProgressIndicator.Border.Width * CurrentProgress
ProgressIndicator.Bar.Width = BarWidth
ProgressIndicator.Text.Caption = "Calculation : " &
ProgressPercentage & "%"
DoEvents
Next i
'==============================================================
'END OF PROCEDURE
Application.CutCopyMode = False
Range("FONDA_UPDATE_ERRORS").Calculate
Range("FONDA_LAST_UPDATE").Select
With Selection
.Value = Now
.NumberFormat = "dd/mm/yyyy h:mm:ss"
End With
Progress = Progress + 1
Application.Calculation = xlCalculationManual
CurrentProgress = Progress / Steps
ProgressPercentage = Round(CurrentProgress * 100, 1)
BarWidth = ProgressIndicator.Border.Width * CurrentProgress
ProgressIndicator.Bar.Width = BarWidth
ProgressIndicator.Text.Caption = "Calculation : " &
ProgressPercentage & "%"
DoEvents
Range(Cells(Range("FONDA_FIRSTROW").Value,
Range("FONDA_FIRSTCOLUMN").Value),
Cells(Range("FONDA_FIRSTROW").Value,
Range("Section_B_F").Column)).Copy
Range(Cells(Range("FONDA_FIRSTROW").Value + 1,
Range("FONDA_FIRSTCOLUMN").Value),
Cells(Range("FONDA_LASTROW").Value,
Range("Section_B_F").Column)).PasteSpecial Paste:=xlPasteFormats
Application.ScreenUpdating = True
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
Range("FONDA_LAST_UPDATE").Select
Application.CalculateBeforeSave = False
ThisWorkbook.Save
MsgBox "Update completed in " & MinutesElapsed & " minutes",
vbInformation + vbOKOnly, "Information"
Call ExitSub
End Sub
The formulae that are meant to be updated are coming from the S&P Capital IQ add-in and follow this syntax :
= #CIQ ( $F39 ;"IQ_NPPE" ; ; LM$37 ; ; ; CURRENCY )
These data are retrieved from online the S&P Capital IQ database.
As a consequence I do not see what I could optimise on this part.
It is also relevant to mention that all the Excel formulae (that do not use a CIQ formulae within) do compute very fast and are not the root cause of the problem : when I update column by column, only the CIQ ones are slow.
Latest lead :
The S&P Capital IQ add-in has a "Refresh Selection" function. I just realised that clicking on it does indeed refresh the data even in manual calculation mode.
When I record a macro and click on this CIQ "Refresh Selection" function, no code is recorded though.
So now my thought is to find a way to make VBA communicate with the CIQ add-in to trigger this CIQ function "Resfresh Selection" from within the VBA code. This way, it could potentially refresh the data with manual calculation and therefore update much faster.
Do you have any idea how to create a link between VBA and another external add-in function ?
Thank you very much !
I'm trying to make a VBA code that allows me to calculate the time ellapsed between two clicks/buttons.
Here is the scenario I'm looking for :
I select an empty cell in the column Time
I click on the START button (to start the counter)
I click on the STOP button (to stop the counter)
The ellapsed time (in the format "hh:mm:dd") has to be put in the selected cell in step 1
Expected output :
I started making a code for the START button but I don't know how the one's for the STOP button.
Sub CalculateTime()
Dim startTime As Double
Dim TimeElapsed As String
startTime = Timer
TimeElapsed = Format((Timer - startTime) / 86400, "hh:mm:ss")
ActiveCell.Value = TimeElapsed
End Sub
Do you have any suggestions, please ?
Any help will be appreciated !
EDIT :
Here is the code of my two subs :
Sub StartButton()
Call CalculateTime(True)
End Sub
'**************************************
Sub StopButton()
ActiveCell.Value = CalculateTime(False)
End Sub
There are various ways to tackle this. One way is to use a global variable (startTime) which is set in your Start button click event. Your Stop button then executes your method and (sans the startTime = Time line obviously).
But I prefer to avoid global variables, so therefore you could rewrite your Sub as a Function and call it twice. Once from the Start button: Call CalculateTime(True). And once from the Stop button: ActiveCell.Value = CalculateTime(False)
Function CalculateTime(ByVal bolStart As Boolean) As String
' Declaring a local variable as Static preserves their value between calls
' of the method.
Static startTime As Double
If bolStart = True Then
' This is the start of the measurement, we simply store the time
startTime = Timer
Else
' This is the end of the measurement, so we calculate the time elapsed
' and return it as a string.
CalculateTime = Format$((Timer - startTime) / 86400, "hh:mm:ss")
End If
End Function
I have ~150 Queries in a Microsoft Excel file. Clicking "Refresh all" would freeze my PC and resulted in some of the data not being able to load correctly even though network connection is good.
I'm looking to find a way to program "Refresh All" button so that it load maybe 5 to 10 queries at a time then move on the the next. I tried that manually and it loads without any problem. Just 150 queries at a time is too much.
Tks.
I couldn't find any simple way of resolving your query, but I have some thougts of a kind of a workaround. Below you can find two VBA macros that may help you a bit. The first code lists all queries that you have in your workbook in a new tab:
Sub ListQueries()
'Add tab to list all queries
Dim wsQueries As Worksheet
Set wsQueries = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wsQueries.Name = "Query list"
wsQueries.Range("a1").Value = "Query name"
Dim con As WorkbookConnection
For Each con In ThisWorkbook.Connections
If UCase(Left(con.Name, 8)) = "QUERY - " Then wsQueries.Range("a1048576").End(xlUp).Offset(1, 0).Value = con.Name
Next con
End Sub
When it is finished you can use the second one. This time it will loop through all queries and refresh them but only as many as you will define in this clause If counter = 10 Then Exit For - if you want 15 then feel free to amend it. For each refereshed query it will add 'Yes' in column B. When you run RefreshQueries it at first checks whether a query is marked as 'Yes' and omit it if it's true.
Sub RefreshQueries()
Dim counter As Byte
counter = 0
'Range with query names
Dim rQueries As Range
Dim rQuery As Range
Dim wsQueries As Worksheet
Set wsQueries = ThisWorkbook.Worksheets("Query list")
Set rQueries = wsQueries.Range("a2:a" & wsQueries.Range("a1048576").End(xlUp).Row)
wsQueries.Range("b1") = "Refreshed"
For Each rQuery In rQueries
If counter = 10 Then Exit For 'if more than 10 queries refreshed then exit loop
'If query is refreshed then omit it and go to next
If rQuery.Offset(0, 1) <> "Yes" Then
ThisWorkbook.Connections(rQuery.Value).Refresh
rQuery.Offset(0, 1) = "Yes"
counter = counter + 1
End If
Next rQuery
End Sub
To sum up, you should run ListQueries once and RefreshQueries as many times as required to refresh all of them.
I want to copy a variable to the clipboard using the PutInClipboard-methode. Due to a known bug in Win10 I need to verify if the content of the clipboard is actually what it's suppose to be.
Unfortunalty it does not work as expected and I need to "enforce" the PutInClipboard-methode by using the wait-Methode, otherwise the comparison returns true, even though the values should not be the same:
'Put the content of a variable into the clipbaord
Dim strDesiredClipboardContent as String
Dim dataObject1 As DataObject
Set dataObject1 = New DataObject
dataObject1.SetText strDesiredClipboardContent
dataObject1.PutInClipboard
'Enforce Execution (otherwise the comparison in the end does not work)
Application.Wait Now + #12:00:01 AM#
'Get whatever is in the clipboard
Dim strActuallClipboardContent
Dim dataObject2 As MSForms.DataObject
Set dataObject2 = New MSForms.DataObject
dataObject2.GetFromClipboard
strActuallClipboardContent = dataObject2.GetText
'Compare
If strDesiredClipboardContent <> strActuallClipboardContent Then
MsgBox "Error"
End If
End Sub
I wonder if there is a different methode to enforce the complete execution of the PutInClipboard-methode then using wait()?! The goal would be to get the correct results but to ad as little "wait-time" as possible.
You could also seperate your macro into 2 parts (e.g.: Macro1 and Macro2) and at the end of the first macro you would use
Application.Ontime Now + TimeSerial(0, 0, 1), "Macro2"
to execute the second part of your code after waiting 1 second.
In my experience, this is more reliable than using Wait or even DoEvents since this will make sure the VBA process completely ends for a brief second. From what I understand, this leaves priority to Excel and the OS to complete the operations that needs to be done i.e.: put string content in the clipboard.
Of late I have been writing macros which require substantial amount of time to execute. (upwards of 5 minutes but some are significantly longer). One of the things I found useful in such cases (other than to wait) is to have Application.StatusBar tell me if it is moving or hung.
However, many times, the Application.Statusbar gets frozen at some value while the program moves ahead. How can this be rectified? Is there anyway we can prevent this so that the statusbar keeps moving as long as the program is moving? Thanks in advance.
I found that the freeze happens at my code when I have many items in the loop. I got around that by using the following code:
For RowNum = 1 To TotalRows
For ColNum = 1 To TotalCols
'code
If ColNum = 1 Then
If RowNum Mod 50 = 0 And ColNum = 1 Then
Application.StatusBar = Format(RowNum / TotalRows, "0%")& " Completed."
End If
Else: Exit For
End If
Next ColNum
Next RowNum
The loop updates the status bar once every 50 rows. This helped the code run a lot faster and eliminated the screen freezing up