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

dimbroane

New Member
Joined
May 6, 2009
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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


VBA Code:
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
 

Attachments

  • Outcome.PNG
    Outcome.PNG
    52.1 KB · Views: 4

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Juppu

New Member
Joined
Oct 2, 2017
Messages
6
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 :)

 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,488
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
That's already in the posted code. ;)
 

Juppu

New Member
Joined
Oct 2, 2017
Messages
6
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

New Member
Joined
May 6, 2009
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hello

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

VBA Code:
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,852
Messages
5,627,255
Members
416,236
Latest member
Lynchbox

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top