IsWBHasCubeFormulas.vb

Function IsWBHasCubeFormulas(Optional Wb As Workbook) As Boolean
    Dim sh As Worksheet
    Dim cell As Range
    Dim bFound As Boolean
    Dim bScreenUpdatingInitial As Boolean
    Dim bEnableEventsInitial As Boolean
    Dim CalcModeInitial As Integer
    Dim rngFormulas As Range
    
    On Error GoTo ErrHandler
    
    If Wb Is Nothing Then
    Set Wb = ThisWorkbook ' ActiveWorkbook ' alternatively
    End If
    
    With Application
        bScreenUpdatingInitial = .ScreenUpdating
        bEnableEventsInitial = .EnableEvents
        CalcModeInitial = .Calculation
        
        ' switch everything off
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    For Each sh In Wb.Sheets
        'Debug.Print sh.Name
        
        Err.Clear
        On Error Resume Next
        Set rngFormulas = sh.Cells.SpecialCells(xlCellTypeFormulas)
        bFound = (Err.Number = 0) ' no error, means SpecialCells returned non-empty range
        Err.Clear
        On Error GoTo ErrHandler
        
        ' if result of SpecialCells was non-empty - check formulas
        If bFound Then
            For Each cell In rngFormulas
                'Debug.Print cell.Formula
                If Left(cell.Formula, 5) = "=CUBE" Then
                    IsWBHasCubeFormulas = True
                    GoTo Exit_Function
                End If
            Next cell
        End If
    Next sh
    
Exit_Function:
    On Error Resume Next
    
    ' restore initial state
    With Application
        .ScreenUpdating = bScreenUpdatingInitial
        .EnableEvents = bEnableEventsInitial
        .Calculation = CalcModeInitial
    End With
    
    Exit Function
    
ErrHandler:
    If Err.Number <> 0 Then
        Debug.Print Now, "IsWBHasCubeFormulas", Err.Number & ": " & Err.Description
        Err.Clear
    End If
    
    GoTo Exit_Function
    Resume ' for debug purpose
End Function