I found the following class file and have edited it to run certain procedures after a background refresh of a QueryTable has completed.
The class events work properly if the QueryTable supplied isn't contained within a ListObject (ie: created via VBA) but fail to trigger if they are. I've tried using Worksheet_Change events to compare the changed range compared to the range of the ListObject but it seems to trigger for some ListObjects but not for others.
Class file:
My usage of the class file:
The class events work properly if the QueryTable supplied isn't contained within a ListObject (ie: created via VBA) but fail to trigger if they are. I've tried using Worksheet_Change events to compare the changed range compared to the range of the ListObject but it seems to trigger for some ListObjects but not for others.
Class file:
VBA Code:
Private Event_Storage As New Collection
Private WithEvents MyQueryTable As Excel.QueryTable
Friend Sub HookUpQueryTable(Query_Info As Variant)
Event_Storage.Add Query_Info
Set MyQueryTable = Query_Info(0)
End Sub
Private Sub MyQueryTable_AfterRefresh(ByVal Success As Boolean)
Dim Query_Object As QueryTable, Workbook_Target As Workbook, Procedure_2_Run As String, Variables As Worksheet, _
Y As Long, AR As Variant, Result As Variant, FNL As Variant, Z As Long, L As Long
If Success Then
'Determine which query just refreshed
For Y = 1 To Event_Storage.Count
AR = Event_Storage(Y)
If AR(0) Is MyQueryTable Then 'IF the refresh querytable is found within collection
Set Query_Object = AR(0)
Procedure_2_Run = AR(1)
Set Workbook_Target = AR(2)
Set Variables = AR(3)
#If Mac Then
If InStr(1, Query_Object.Name, "Time") > 0 Then
With Query_Object
With .ResultRange
Result = .Value2
.ClearContents
End With
End With
With Variables.ListObjects("Time_Zones").DataBodyRange.Cells(1, 1)
.Resize(UBound(Result, 1), UBound(Result, 2)).Value2 = Result
End With
End If
#Else
#End If
Event_Storage.Remove (Y)
If InStr(1, Query_Object.Name, "Schedule") > 0 Then 'Schedule Procedures
Application.Run "'" & Workbook_Target.Name & "'!" & Procedure_2_Run, True
ElseIf InStr(1, Query_Object.Name, "Time") > 0 Then
Application.Run "'" & Workbook_Target.Name & "'!" & Procedure_2_Run
End If
Exit For
End If
Next Y
End If
End SubMy usage of the class file:
Code:
Private Sub Time_Zones_Refresh()
Dim QT As QueryTable, Query_Events As New ClassQTE
#If Mac Then
Dim Query_Exists As Boolean, TB As String, Result() As Variant
For Each QT In sheet1.QueryTables
'Debug.Print QT.Name
If InStr(1, QT.Name, "Time_Z") > 0 Then
Query_Exists = True
Exit For
End If
Next QT
If Not Query_Exists Then 'Create Query
TB = "https://docs.google.com/spreadsheets/d/1ubpPnoj7hQkMkwgLpFwOwmFftWI4yN3jMihEshVC89A/export?format=csv&id=1ubpPnoj7hQkMkwgLpFwOwmFftWI4yN3jMihEshVC89A&gid=0"
Set QT = sheet1.QueryTables.Add(Connection:="TEXT;" & TB, Destination:=sheet1.Range("A1"))
With QT
.TextFileCommaDelimiter = True
.WorkbookConnection.Name = "Time_Zones_R"
.Name = "Time_Z"
.RefreshStyle = xlOverwriteCells
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
End With
End If
#Else
Set QT = Variable_Sheet.ListObjects("Time_Zones").QueryTable
#End If
Query_Events.HookUpQueryTable Array(QT, "Release_Schedule_Refresh", ThisWorkbook, sheet2)
'0 1 2 3
QT.Refresh True 'Background refresh
End Sub
Last edited:
