Augmenting VBA to Refresh Specific before All Power Queries

[johnny51981]

Howdy!
I am currently using these two pieces of VBA to refresh my Power Queries and it works beautifully. But I was wondering if anyone is able to assist in augmenting it a bit.

It currently produces the information displayed in this picture:

My need is to be able to run anything that begins with the word "FALLOUT" as well as the File Dates in the Table Name. I have a cell that flags there being fallout if at least 1 of the now 2 fallout queries produce any results. Those results then get manually added to a landing table used for different conversions and whatnot. Not looking for this swivel to the landing table to be automated).
If the fallout queries do produce results, I would like the code to stop there and include an alert stating there are items needing to be address. But if there are no results, complete the refresh on remaining queries, in this example it would be the "Invoice _Tracking" query.
The code must be able to be dynamic as I have other reports that this will be implemented in, they are all consistent in holding the fallout and file date queries, its the quantities and names of the remaining queries that does vary.

Any help would be greatly appreciated.


Here is the current VBA

Class Module

'Class module - clsQuery

'Each instance of this class contains details about a specific query table and handles
'the BeforeRefresh and AfterRefresh events when the query table is changed.

Option Explicit

Private WithEvents pQueryTable As QueryTable

Private pStatusBaseCell As Range
Private pRefreshStartTime As Date
Private pRefreshEndTime As Date

Public Property Get QueryTable() As QueryTable
    Set QueryTable = pQueryTable
End Property

Public Property Set QueryTable(ByVal qt As QueryTable)
    Set pQueryTable = qt
End Property

Public Property Get StatusBaseCell() As Range
    StatusBaseCell = pStatusBaseCell
End Property

Public Property Set StatusBaseCell(baseCell As Range)
    Set pStatusBaseCell = baseCell
End Property


Private Sub pQueryTable_BeforeRefresh(Cancel As Boolean)
  
    pRefreshStartTime = Now
    With pQueryTable
        pStatusBaseCell.Resize(, 5).Value = Array(.ListObject.Name, "'" & .Destination.Worksheet.Name & "'!" & .Destination.Address, pRefreshStartTime, "", "Refresh Running")
    End With
  
End Sub


Private Sub pQueryTable_AfterRefresh(ByVal Success As Boolean)
  
    pRefreshEndTime = Now
    With pQueryTable
        If Success Then
            pStatusBaseCell.Resize(, 5).Value = Array(.ListObject.Name, "'" & .Destination.Worksheet.Name & "'!" & .Destination.Address, pRefreshStartTime, pRefreshEndTime, "Succeeded")
        Else
            pStatusBaseCell.Resize(, 5).Value = Array(.ListObject.Name, "'" & .Destination.Worksheet.Name & "'!" & .Destination.Address, pRefreshStartTime, pRefreshEndTime, "Failed")
        End If
    End With

End Sub

Module

Option Explicit

'Dictionary which holds multiple clsQuery objects
Public queryTablesDict As Object 'Scripting.Dictionary
Public Sub Refresh_QueriesOnly()
 
    Dim statusSheet As Worksheet, baseCell As Range
    Dim ws As Worksheet
    Dim table As ListObject
    Dim qt As QueryTable
    Dim thisQuery As clsQuery
    Dim i As Long
  
    Set statusSheet = ThisWorkbook.Worksheets("Settings")
  
    With statusSheet
        .Range("I1:M10").ClearContents
        .Range("I1:M1").Value = Array("Table Name", "Destination Cell", "Refresh Start Time", "Refresh End Time", "Refresh Status")
        Set baseCell = .Range("I2")
        .Activate
    End With
  
    Set queryTablesDict = CreateObject("Scripting.Dictionary")
  
    i = 0
    For Each ws In ThisWorkbook.Worksheets
        For Each table In ws.ListObjects
            On Error Resume Next
            Set qt = table.QueryTable
            On Error GoTo 0
            If Not qt Is Nothing Then
              
                'Create a new instance of a clsQuery with this query table and add it to the dictionary
              
                Set thisQuery = New clsQuery
                Set thisQuery.QueryTable = qt
                Set thisQuery.StatusBaseCell = baseCell.Offset(i)
                queryTablesDict.Add Key:=table.Name, Item:=thisQuery
                i = i + 1
              
                'Refresh this query
              
                qt.Refresh BackgroundQuery:=True
                Set qt = Nothing
            End If
        Next
    Next

End Sub

 

[sijpie]

There are a number of thingd in your post that I don't understand:

The order:

1. you run the query on all tables in the workbook, which produces the query table
2. you inspect the rows for Fallout lines
3. When there are two Fallout lines you do something

is that correct? Or is the order:

1. Run the query on each table
2. inspect the output after each table, if two lines with fallout, then run something, else
3. continue with next table

My need is to be able to run anything that begins with the word "FALLOUT" as well as the File Dates in the Table Name

what do you mean with 'to run anything that begins with fallout'? What is running?

 

[johnny51981]

Currently:
VBA refreshes all queries simultaneously and produces rows in their respective tables that are somewhere on a sheet in the workbook.

Desired Change:
VBA refreshes only queries that begin with the word "FALLOUT" simultaneously, as well as the File Dates (as displayed in the picture in the original post).
If results are produced in the FALLOUT tables (there is an existing Named location that declares this), then Message Box saying there's fallout.
If no results are produced in the FALLOUT tables, then refresh remaining queries.

The VBA that I provided allows for all queries to open up for simultaneous refresh, more intelligently than using the RefreshAll function.