I have 3 workbook web queries on a single data sheet , and I have a dropdown object with a list of months in the year (1-12). My idea for the automation was to have the query formula update based on the user selection of the dropdown value and update the query formula accordingly and refresh.
The VBA code works fine, but I get this message for one of the queries.
The reason is that the query (ex when changed from month 2 to month 3), has 2 more lines and is not the exact table height.
Any ideas how to debug this / circumvent this message. Code below:
Sub DropDown9_Change()
Dim wbconn As WorkbookConnection, qT As QueryTable
Dim wB As Workbook, wS As Worksheet
'For Each wbconn In ThisWorkbook.Connections
'Debug.Print wbconn.Name & " - " & wbconn.OLEDBConnection.CommandText & " - " & _
'wbconn.OLEDBConnection.SourceDataFile
''wbconn.Refresh
'Next wbconn
Set wB = Workbooks("OH Burdening Template.xlsb")
If ShData.Shapes("Drop Down 9").ControlFormat.Value > _
ShCalendar.Range("B3").Value Then
MsgBox "Cannot be based on future periods!", vbExclamation
Else
'Refresh WB queries
Call Refresh_Queries(ShData.Shapes("Drop Down 9").ControlFormat.Value, wB, ShData)
End If
ShData.Columns.AutoFit
End Sub
Private Function Refresh_Queries(ByVal Period As Integer, ByVal wB As Workbook, _
ByVal thisSheet As Worksheet)
With Application
.StatusBar = "Now refreshing queries on :" & ShData.Name
.ScreenUpdating = False
.EnableEvents = False
End With
Dim I As Integer, LObj As ListObject
Dim strL As Integer, str As String
Dim Pos As Integer
Dim F As String
Dim startPos As Integer
str = "?year=2018&period="
strL = Len(str)
For I = 1 To wB.Queries.Count
On Error GoTo view_err
F = wB.Queries(I).Formula
Pos = VBA.InStr(1, F, str, vbBinaryCompare)
startPos = Pos + strL
'Debug.Print F
'Replacing the period part of the string with the period entered in the dropdown
F = WorksheetFunction.Replace(F, startPos, 1, Period)
wB.Queries.Item(I).Formula = F
'Debug.Print Mid(F, startPos, 1)
Next I
For Each LObj In thisSheet.ListObjects
Application.StatusBar = "Refreshing " & LObj.Name
LObj.QueryTable.Refresh False
Debug.Print LObj.Name & Chr(32) & "Refreshed successfully!"
Next LObj
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
End With
Set LObj = Nothing
Exit Function
view_err:
Debug.Print LObj.Name & Chr(32) & "Refresh Failed!"
MsgBox Err.Description & " (" & Err.Number & ")", vbExclamation
With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
End With
End Function
