Question

I'm trying to build range-level refreshing of Cube Functions into a large Cube-formula based workbook, since the build in batching of these functions invariably performs dreadfully on the Cube available when the whole workbook is refreshed (hours and hours of waiting).

The code I'm trying to use is pretty simple:

Public Sub RefreshRange()
    Dim rngTarget As Excel.Range
    Dim lngRescue As Long
    Dim blnCalcCheck As Boolean

    Set rngTarget = Selection
    Do
        rngTarget.Dirty
        rngTarget.Calculate
        DoEvents               '' Used reluctantly in case VBA blocks the event that
                               '' causes a recalc
        blnCalcCheck = blnCalcCheck Or ThisWorkbook.Connections("MyConnection").OLEDBConnection.Refreshing
        lngrescue = lngRescue + 1
        Sleep 200              '' API sleep function. Also tried Application.Wait.
        If lngRescue >= 200 Then Debug.Assert False

    Loop Until Not fblnIsGettingData(rngTarget) '' This function doesn't do much that 
                                                '' could break things. Just evaluates
                                                '' a formula for rngTarget that checks
                                                '' if any of the cells read 
                                                '' #GETTING_DATA

End Sub

This doesn't work. The formulas calculate, resolving to #GETTING_DATA, but the connection never begins the process of collecting the data to go in them. This only begins, with varying degrees of reliability if I

  • Recalculate the sheet (Shift-F9) manually. This works around 50% of the time.
  • Recalculate the whole workbook manually. This works around 80% of the time.
  • Set the calculation mode to automatic. This always works (so far), but is always workbook-level.

It may also begin working if I call Application.CalculateUntilAsyncQueriesDone, but I'm not sure as this is clearly a workbook level function and more's the point, consistently seems to crash my workbook (I'd guess because I'm using UDFs in frequently used names, but not sure).

Does anyone have any idea how to manually fire whatever event it is that kicks off the whole "Running Background Query" message for the range? Or alternatively, how I can watch the Excel.Exe process in order to find this out and potentially fire the same thing via API?

Was it helpful?

Solution

The reason this doesn't work is because, for whatever reason, the post calculation events that trigger asynchronous connections to go and get data with Cube Value formulae cannot trigger whilst VBA is running. That INCLUDES VBA where DoEvents is called (hence the code above does not work).

However, the event is scheduled and does fire - once, irrespective of how many times Calculate has been called - once VBA finishes doing whatever it is doing. This makes coding around complex, but not impossible, by using timers (I eventually settled on Application.OnTime in order to be able to easily class everything up, but the API SetTimer would probably also work. A very simple approach to solving the problem is (possible mistakes here, since I'm REALLY unused to using static):

Public Static Sub DoCalcEvery(Optional strInterval As String = vbNulLString, Optional wksTarget As Excel.Worksheet, blnContinue As Boolean = True)
    Dim strInterval_Inner As String
    Dim wksTarget_Inner as Excel.Worksheet
    Dim blnContinue_Inner As Boolean
    Dim lngCalcCount As Long
    Dim datNewCalcTime As Date
    Dim datPreviousCalcTime As Date

    '' Update static values if any new arguments provided
    '' Stopping is a little tricky too - hence blnContinue
    If strInterval <> vbNullString Then strInterval_Inner = strInterval
    If Not wksTarget Is Nothing Then Set wksTarget_Inner = wksTarget
    If lngCalcCount = 0 Then 
        blnContinue_Inner = blnContinue
    ElseIf blnContinue <> True Then
        blnContinue_Inner = False
    End If

    '' Clear out any previous OnTime instances
    '' This frequently (always?) errors, but looks like it is usually wrapped in 
    '' On Error elsewhere, so guessing in THIS specific case, the error is safely
    '' ignored.
    On Error Resume Next
    Application.OnTime datPreviousCalcTime, "DoCalcEvery", , False
    On Error Goto 0

    wksTarget.Calculate
    lngCalcCount = lngCalcCount + 1
    If blnContinue_Inner Then
        datNewCalcTime = Now + CDat(strInterval)
        Application.OnTime datNewCalcTime, "DoCalcEvery"
        datPreviousCalcTime = datNewCalcTime
    Else
        Debug.Print "Calculation complete. " & lngCalcCount & " iterations before stopped."
    End If
End Sub

This SHOULD work, and allow you DoCalcEvery to be called at an arbitrary time to stop calculation. HOWEVER, if this approach is used there are some things to bear in mind if you're not familiar with OnTime:

  • OnTime is valid for the entirety of this Excel session unless cancelled That means that if you leave Excel running for more than 24 hour, expect the macro to fire again. I am TOLD that this may even open closed workbooks in order to accomplish the effect, so be warned. OnTime events are invalidated when Excel closes though.
  • This means that if you halt the code by clicking stop, on an error elsewhere in VBA, or by some other means, you have NO WAY to know which OnTime events are currently scheduled (if anyone does know how to find this, I'd love to know)

However, with these provisos in mind, this approach will allow the right events to fire to set off the cube functions. Detecting when they're done, of course, is a completely different kettle of fish.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top