Refresh Queries in All Worksheet

[AccessUser777 via OfficeKB.com]

Hi all,
Need some help on an excel project I've been tasked with. I have an excel
wookbook that has several worksheets. Within the worksheets I have a query
thats pulling data from an MS Access db. I'm trying to create a macro using
VBA to refresh each query in every worksheet. I've seached previous post on
this site and have tried applying some of the codes without much success.
The first code I tried is listed below but it would miss some of the
worksheets and the data on the missed worksheets wouldn't refresh.

Application.DisplayAlerts = False
Sheets("MTD").Select
Range("B5").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Sheets("DAILY").Select
Range("B5").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Sheets("WKND").Select
Range("B5").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Sheets("MTD-DETAIL").Select
Range("B5").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Sheets("DAILY-DETAIL").Select
Range("B5").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Sheets("WKND-DETAIL").Select
Range("B5").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Sheets("DAILY-DETAIL").Select
Range("B5").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
'MESSAGE BOX TO CONFIRM UPDATE IS COMPLETE'
MsgBox ("UPDATES ARE NOW COMPLETE! ")


Next I foud the following code, however, it get a run time error after it
hits the fouth worksheet

Sub GET_VOLUME()
Dim WS As Worksheet
Dim QT As QueryTable

For Each WS In ActiveWorkbook.Worksheets
For Each QT In WS.QueryTables
QT.Refresh
Next QT
Next WS
End Sub

What code should I be using? Am I in the right direction or am I waaaay out
in left field?
Any help is appreciated. Thanks!!!!

 

[Joel]

The second macro should work since you get an error it must mean the query
is corrupted. Probaly the source data file doesn't exist or the table in the
database no longer exists. Yo have to find which queries don't work and
delete these queries.

Go to menu
Insert Names Define

All the queries should be listed as a named range. Yo need to remove from
the name range table the invalid queries. the code below should help you
find all the queries.

Sub DebugQuery()
Dim WS As Worksheet
Dim QT As QueryTable

Sheets.Add after:=Sheets(Sheets.Count)
Set Sht = ActiveSheet
With Sht
.Name = "Debug"
.Range("A1") = "Sheet Name"
.Range("B1") = "Row"
.Range("C1") = "Column"
.Range("D1") = "Connection"
.Range("E1") = "Command Text"

RowCount = 2
End With

For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "Debug" Then
With WS
For Each QT In .QueryTables
Sht.Range("A" & RowCount) = .Name
Sht.Range("B" & RowCount) = QT.ResultRange.Row
Sht.Range("C" & RowCount) = QT.ResultRange.Column
Sht.Range("D" & RowCount) = QT.Connection
Sht.Range("E" & RowCount) = QT.CommandText
RowCount = RowCount + 1
'QT.Refresh
Next QT
End With
End If
Next WS
End Sub

 

[AccessUser777 via OfficeKB.com]

Thanks Joel...the debug qry worked...and you were correct, I had an invalid
query. I've fixed the query and applied the second macro and now my
spreadsheet works great. Thanks again.

The second macro should work since you get an error it must mean the query
is corrupted. Probaly the source data file doesn't exist or the table in the
database no longer exists. Yo have to find which queries don't work and
delete these queries.

Go to menu
Insert Names Define

All the queries should be listed as a named range. Yo need to remove from
the name range table the invalid queries. the code below should help you
find all the queries.

Sub DebugQuery()
Dim WS As Worksheet
Dim QT As QueryTable

Sheets.Add after:=Sheets(Sheets.Count)
Set Sht = ActiveSheet
With Sht
.Name = "Debug"
.Range("A1") = "Sheet Name"
.Range("B1") = "Row"
.Range("C1") = "Column"
.Range("D1") = "Connection"
.Range("E1") = "Command Text"

RowCount = 2
End With

For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "Debug" Then
With WS
For Each QT In .QueryTables
Sht.Range("A" & RowCount) = .Name
Sht.Range("B" & RowCount) = QT.ResultRange.Row
Sht.Range("C" & RowCount) = QT.ResultRange.Column
Sht.Range("D" & RowCount) = QT.Connection
Sht.Range("E" & RowCount) = QT.CommandText
RowCount = RowCount + 1
'QT.Refresh
Next QT
End With
End If
Next WS
End Sub

Hi all,
Need some help on an excel project I've been tasked with. I have an excel

[quoted text clipped - 47 lines]

in left field?
Any help is appreciated. Thanks!!!!