johnny51981
Active Member
- Joined
- Jun 8, 2015
- Messages
- 398
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
Module
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
VBA Code:
'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
VBA Code:
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