Refresh data model succeeds, but leaves workbooks showing #N/A

[dimbroane]

Hello

My code opens (in sequence) all Excel files saved in a folder, refreshes them (their data models aggregate various tables of an SQL database) and closes them.
The code works well, does what it's supposed to do, but leaves the files with a #N/A error in all cells that use a CUBEVALUE formula. There is no pivot table involved.
I have attached an image showing the output.

To overcome the issue, I have to open all files, one by one. On opening, the data model finishes the refresh and returns real numbers.
Certainly, I cannot do that, else the presence of the code is not necessary.

The files are in an Automatic Calculation Mode.

I am inserting below the code I use.
For the life of me I cannot figure out why the files are not fully 100% refreshed when they are closed.

Thank you for your help

Option Explicit

Private Sub cmdOpenRefresh_Click()

    Call loopAllSubFolderSelectStartDirectory

End Sub

Sub loopAllSubFolderSelectStartDirectory()
    
    Dim fd As FileDialog: Set fd = Application.FileDialog(msoFileDialogFolderPicker)

    With fd
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path & "\Monthly Rolling Forecasts"
        .Title = "Open the folder containing the current forecast iteration"
        .ButtonName = "Go!"
        .InitialView = msoFileDialogViewDetails
    End With

    Dim bFolderWasChoosen As Boolean
    bFolderWasChoosen = fd.Show
    If bFolderWasChoosen Then
        Call LoopAllSubFolders(fd.SelectedItems(1))
    Else
        Exit Sub
    End If

    Set fd = Nothing

End Sub

'List all files in subfolders
Sub LoopAllSubFolders(ByVal sFolderPath As String)

'adapted from:
'https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/

    Dim sFilename As String, sFullFilePath As String, lNumFolders As Long, arrFolders() As String
    Dim i As Long
    
    If VBA.Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
    sFilename = VBA.Dir(sFolderPath & "\*.*", vbDirectory)
    
    Do
        If VBA.Left(sFilename, 1) <> "." Then
            sFullFilePath = sFolderPath & sFilename
            If (GetAttr(sFullFilePath) And vbDirectory) = vbDirectory Then
                ReDim Preserve arrFolders(0 To lNumFolders) As String
                arrFolders(lNumFolders) = sFullFilePath
                lNumFolders = lNumFolders + 1
            Else
                'Insert the actions to be performed on each file
                'This example will print the full file path to the immediate window
                Dim sFilePath As String: sFilePath = CheckWkbOpen(sFolderPath & sFilename)
                Dim wkb As Workbook
                
                If sFilePath = True Then
                    Exit Sub
                Else
                    Set wkb = Workbooks.Open(filename:=sFolderPath & sFilename)
                End If
                
                wkb.Model.Refresh
                With Application
                    .CalculateUntilAsyncQueriesDone
                    .Calculation = xlCalculationAutomatic
                End With
                wkb.Close SaveChanges:=True
                Set wkb = Nothing
                
            End If
        End If
        sFilename = VBA.Dir()
    Loop Until sFilename = ""
    
    For i = 0 To lNumFolders - 1
        LoopAllSubFolders arrFolders(i)
    Next i
    
End Sub

Private Function CheckWkbOpen(sFilename As String) As Boolean

'adapted from:
'https://exceloffthegrid.com/vba-code-loop-files-folder-sub-folders/

    Dim lFileNo As Long, lErrorNo As Long
    
    On Error Resume Next
    
    lFileNo = VBA.FreeFile()
    Open sFilename For Input Lock Read As #lFileNo
    Close lFileNo
    
    lErrorNo = Err
    
    On Error GoTo 0
    
    Select Case lErrorNo
        Case 0
            CheckWkbOpen = False
        Case 70
            CheckWkbOpen = True
        Case Else
            Error lErrorNo
    End Select
    
End Function

 

[Juppu]

I have had a semilar problem before, i solved it using Application.CalculateUntilAsyncQueriesDone
that will force the code to wait until the refresh is done.

Hope i helps

Excel vba refresh wait

I am creating some code where I can click on a single button and it will refresh the querytables that I have on that sheet. Now, my problem is that I have more code after the fresh that copies som...

stackoverflow.com

 

[RoryA]

That's already in the posted code.

 

[Juppu]

haha lol sorry ?

Have you tried the Application.Wait (Now + TimeValue("0:00:10")) to see if it is a time issue, or maybe the issue is something else.

 

[dimbroane]

Hello

@Juppu, I've tried every single possible solution, to no avail, until I found somewhere else the answer:

Sub WaitForRefresh()

    With Application
        .Calculation = xlCalculationAutomatic
        .CalculateUntilAsyncQueriesDone
        Do Until .CalculationState = xlDone
        Loop
    End With

End Sub

I wouldn't have thought that the Do Until Application.CalculationState = xlDone could do the trick.

This thread could be closed now.
I hope the solution helps somebody.