VBA waits for Cube formulas to refresh (Application.CalculateUntilAsyncQueriesDone)

[Polis]

Dear colleagues, I have a macro that loops through and updates reports that include cube formulas (OLAP). The problem is that my VBA code just would not wait for cube functions to refresh and calculate. I spent a good few hours searching web to find that "Application.CalculateUntilAsyncQueriesDone" after the .RefreshAll command should make the code wait untill the refresh is completed. However, when I implemented this in my code, the first file opens up and freezes over (indefinite loop). I would very much appreciate any help here. I am using Excel 2010 and cube formulas in my reports (CUBEMEMBER, CUBESET, CUBEVALUE etc.). Thank you. Vojta

Sub NEW_ForecastUpdate()
 Dim TargetFolder As String
 Const FILE_EXT As String = "xls*"
 Dim FileName As String
 Dim wbTemp As Workbook, wsTemp As Worksheet
 TargetFolder = "\\grafton.local\grceedfs1\GR-CEE_SharedData\REPORTING FY14-15\test\"
    
    FileName = Dir$(TargetFolder & "*." & FILE_EXT)
        
    Do While Len(FileName) > 0
        Set wbTemp = Workbooks.Open(TargetFolder & FileName)
        
        With wbTemp
        
                For Each wsTemp In ActiveWorkbook.Worksheets
                    wsTemp.Unprotect Password:="usk"
                Next wsTemp
                .RefreshAll
                Application.CalculateUntilAsyncQueriesDone
                
                For Each wsTemp In ActiveWorkbook.Worksheets
                    wsTemp.Protect Password:="usk", DrawingObjects:=True, Contents:=True, Scenarios:=True _
                    , AllowFormattingColumns:=True
                Next wsTemp
    
                .Save
                .Close
        End With
               
                FileName = Dir$
    Loop
End Sub

 

[Shrikant]

Hope this post would help

http://www.mrexcel.com/forum/excel-...l-finish-autocalcs-turning-back-too-soon.html

 

[Polis]

Thank you for your reply Shrikant. The post you mentioned suggest inserting of following code: Do Until Application.CalculationState = xlDone
ActiveWorkbook.RefreshAll Unfortunately this does not seem to hold the vba code. It goes on and saves the file before the refresh finishes. The whole code with suggested adjustment looks as follows: Sub NEW_ForecastUpdate()
Dim TargetFolder As String
Const FILE_EXT As String = "xls*"
Dim FileName As String
Dim wbTemp As Workbook, wsTemp As Worksheet
TargetFolder = "\\grafton.local\grceedfs1\GR-CEE_SharedData\REPORTING FY14-15\test\"

FileName = Dir$(TargetFolder & "*." & FILE_EXT)

Do While Len(FileName) > 0
Set wbTemp = Workbooks.Open(TargetFolder & FileName)

With wbTemp

For Each wsTemp In ActiveWorkbook.Worksheets
wsTemp.Unprotect Password:="usk"
Next wsTemp

Do Until Application.CalculationState = xlDone
ActiveWorkbook.RefreshAll
Loop

For Each wsTemp In ActiveWorkbook.Worksheets
wsTemp.Protect Password:="usk", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True
Next wsTemp

.Save
.Close
End With

FileName = Dir$
Loop
End Sub

 

[Shrikant]

Polis,

personally i haven't tried anything from that post. (I still have not encountered data that big.) I saved that post only for future if need be..

Try Peter_SSs's (He is MrExcel MVP+Moderator) suggestion by putting DoEvents in the code.

 

[Polis]

Shrikant, they are apparently turning on and off automatic recalculation (code was not posted). My code does not play with turning automatic recalc on and off and therefore "DoEvents" is of no use. Thank you your help anyway!

 

[Shrikant]

I have found a code. It is slight different.

Your code...
The place where you need to calculate things before moving ahead.

Application.Calculate
If Not Application.CalculationState = xlDone Then
    DoEvents
End If

code resumes....

 

[Polis]

Hi, I have incorporated into my code as follows. Unfortunately, this would not work wither. Code just would not wait..Thanks a lot anyway. Sub NEW_ForecastUpdate()
Dim TargetFolder As String
Const FILE_EXT As String = "xls*"
Dim FileName As String
Dim wbTemp As Workbook, wsTemp As Worksheet
TargetFolder = "\\grafton.local\grceedfs1\GR-CEE_SharedData\REPORTING FY14-15\test\"

FileName = Dir$(TargetFolder & "*." & FILE_EXT)

Do While Len(FileName) > 0
Set wbTemp = Workbooks.Open(TargetFolder & FileName)

With wbTemp

For Each wsTemp In ActiveWorkbook.Worksheets
wsTemp.Unprotect Password:="usk"
Next wsTemp
.RefreshAll
Application.Calculate

If Not Application.CalculationState = xlDone Then
DoEvents
End If

For Each wsTemp In ActiveWorkbook.Worksheets
wsTemp.Protect Password:="usk", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True
Next wsTemp

.Save
.Close
End With

FileName = Dir$
Loop
End Sub

 

[mxmotz]

This is working for me now.....

ActiveWorkbook.RefreshAll

'Wait for Refresh to finish before running vba
Application.CalculateUntilAsyncQueriesDone
If Not Application.CalculationState = xlDone Then
DoEvents
End If

Code resumes . . . . .

 

[alemarquezr]

Hi mxmotz,

I'm trying to use your code but still my excel file goes to the CUBE and run OLAP query

how do you exactly use it?

Thanks!

AM

 

[parulmeh]

This is working for me now.....

ActiveWorkbook.RefreshAll

'Wait for Refresh to finish before running vba
Application.CalculateUntilAsyncQueriesDone
If Not Application.CalculationState = xlDone Then
DoEvents
End If

Code resumes . . . . .

This code was really helpful. Thanks for putting it.