Suspend VBA macro execution until calculations are finished - vba

Question

I need to suspend macro execution until all calculations are finished.
I tried using loops with and without DoEvents checking CalculationState but the loop never ends.
Do Until Application.CalculationState = xlDone
DoEvents
Loop

Answer 1

Have you looked at handling the application's AfterCalculate() event (see https://learn.microsoft.com/en-us/office/vba/api/excel.application.aftercalculate)?
You need to create a class which contains the Application object in order to access the handler. You can then call whatever routine you wish from there. If you had more than one routine to call depending on what is being calculated you could set, say, an enum to point to the right procedure. I've called this class cApp and skeleton code for that would be:
Option Explicit
Public Enum ProcAferCalcCode
None
DeliveryProc
TimeProc
End Enum
Private WithEvents mApp As Application
Private mProcAfterCalcCode As ProcAferCalcCode
Public Property Let ProcAfterCalc(RHS As ProcAferCalcCode)
mProcAfterCalcCode = RHS
End Property
Private Sub Class_Initialize()
mProcAfterCalcCode = None
Set mApp = Application
End Sub
Private Sub mApp_AfterCalculate()
Select Case mProcAfterCalcCode
Case DeliveryProc
SetDeliveryOptions
Case TimeProc
SetTime
End Select
End Sub
In this example, I have a one-row table that looks like this:
When the user enters a quantity, and the 'Price' cell calculates (A * B), a routine is called that populates the validation list in the 'Delivery' column. When a delivery option is selected, and the 'Cost' cell calculates (A * D), a routine is called that retrieves delivery times. It's a trite example, but should give you an idea on how to code it.
Code in a module looks like this:
Option Explicit
Private mApp As cApp
Public Sub RunMe()
Debug.Print "RunMe() called..."
If MsgBox("Ready to enter qty?", vbYesNo) = vbYes Then
Debug.Print "Some user action confirmed."
Set mApp = New cApp
mApp.ProcAfterCalc = DeliveryProc
End If
Debug.Print "RunMe() ended."
Debug.Print "** No procedure is running **" & vbNewLine
End Sub
Public Sub SetDeliveryOptions()
Dim cell As Range
Dim del As String
Debug.Print "SetDeliveryOptions() called..."
mApp.ProcAfterCalc = None
Set cell = Sheet1.ListObjects("Table1").ListColumns("Price").DataBodyRange
Debug.Print "Price is " & cell.Value2
'Mimic some task.
Select Case cell.Value2
Case 0
del = vbNullString
Case Is < 5
del = "$5 - Standard"
Case Is < 10
del = "$5 - Standard, $6 - Express"
Case Else
del = "$5 - Standard, $6 - Express, $7 - Next Day"
End Select
With cell.Offset(, 1)
.Value = Empty
With .Validation
.Delete
.Add xlValidateList, xlValidAlertStop, xlBetween, del
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End With
mApp.ProcAfterCalc = TimeProc
Debug.Print "SetDeliveryOptions() ended."
Debug.Print "** No procedure is running **" & vbNewLine
End Sub
Public Sub SetTime()
Dim cell As Range
Dim d As Long
Debug.Print "SetTime() called..."
mApp.ProcAfterCalc = None
Set cell = Sheet1.ListObjects("Table1").ListColumns("Delivery").DataBodyRange
Debug.Print "Delivery Option is " & cell.Value
'Mimic some other task.
Select Case cell.Value2
Case Is = "$5 - Standard"
d = Int((10 - 5 + 1) * Rnd + 5)
Case Is = "$6 - Express"
d = Int((5 - 2 + 1) * Rnd + 2)
Case Is = "$7 - Next Day"
d = 1
Case Else
d = 0
End Select
cell.Offset(, 1) = d
Debug.Print "SetTime() ended."
Debug.Print "** No procedure is running **" & vbNewLine
End Sub
The immediate window outputs the following:
RunMe() called...
Some user action confirmed.
RunMe() ended.
** No procedure is running **
SetDeliveryOptions() called...
Price is 25
SetDeliveryOptions() ended.
** No procedure is running **
SetTime() called...
Delivery Option is $7 - Next Day
SetTime() ended.
** No procedure is running **

Answer 2

What state is it in?
List item xlCalculating 1 Calculations in process.
List item xlDone 0 Calculations complete.
List item xlPending 2 Changes that trigger calculation have been made, but a recalculation has not yet been performed.
It might help you determine what is happening on your worksheets.