Excel2000 VBA: How force the procedure to wait until queries are r
Hi
I got 3rd possibility too meanwhile from Dr. Eckehard Pfeifer
(microsoft.public.de.excel) - to use AfterRefresh events of queries. As much
as I can decide, part of code remains in procedure, then the 1st query is
started, after this query is refreshed, in AfterRefresh the second one is
started, and in AtherRefresh of 3nd query the rest of code is processed.
Tomorrow IŽll try all those solutions out.
Arvi Laanemets
"K Dales" wrote in message
...
Two possibilities: set the querytable so it does NOT do background
refreshing
- forces Excel to wait for it to finish:
qtQtrResults.BackgroundQuery = False
Or, to ensure it is done refreshing before continuing:
With qtQtrResults
.CommandType = xlCmdSql
.Refresh
While .Refreshing
' Display a message here, e.g., Please wait... query
refreshing
DoEvents
Wend
End With
- This would eliminate your need for a time delay (which is not really a
good option, since there are factors out of your control that will affect
the
time it takes the query to process)
"Arvi Laanemets" wrote:
Hi
The procedure below must delete all data from a table, which have given
dates, refresh two queries based on this table, and recalculate some
values
(last and previous price for item in data table, and the difference)
adjacent to one of query tables. The problem is, that the code don't
wait
until queries are refreshed - as result recalculated values will be
wrong,
or - when the number of different dates in table will be less than 2 -
the
procedure stops with error. I tried to use Application.Wait, but it
didn't
help (the waiting time was ~1 - 5 minutes, depending on number of rows
in
data table).
How can I test, are queries finished refreshing, and to continue with
code
after that?
Thanks in advance!
--
Arvi Laanemets
( My real mail address: arvil<attarkon.ee )
********
Public Sub DeleData()
' Status bar text
oldstatusbar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
' Ask for date which data are deleted
varDate = CDate(InputBox("Insert a date (in format 'dd.mm.yyyy') to
be
deleted!"))
' Check for presence of data for same date in summary workbook
If ThisWorkbook.Sheets("Data").UsedRange.Find(varDate ) Is Nothing
Then
varMsg = MsgBox("No data for this date exist in table!",
vbOKOnly)
Else
varMsg = MsgBox("Are you sure you want to delete all data for "
&
Format(varDate, "dd.mm.yyyy") & "?", vbOKCancel)
If varMsg = 1 Then
varContinue = True
Application.StatusBar = "Deleting data with selected date
...."
varRow1 = Application.WorksheetFunction.Match(CLng(varDate),
[DataDate], 0) + 1
varRow2 = varRow1 +
Application.WorksheetFunction.CountIf([DataDate], CDate(varDate)) - 1
ThisWorkbook.Sheets("Data").Rows(varRow1 & ":" &
varRow2).Delete
Shift:=xlUp
End If
End If
If varContinue Then
' Redefine summary data table
varSummaryRows = [DataRows]
ThisWorkbook.Names("DataTbl").RefersTo = "=Data!$B$1:$H$" &
varSummaryRows
' Refresh Article list
' The query creates an unique article list from DataTbl,
containing
columns
' Article, ArticleDescription, LEFT(Article) As Group
Application.StatusBar = "Refreshing Article list ..."
Set qtQtrResults = Worksheets("Articles").QueryTables(1)
ThisWorkbook.Sheets("Articles").Activate
ActiveSheet.Range("A1").Select
With qtQtrResults
.CommandType = xlCmdSql
.Refresh
End With
' Refresh Dates list
' The query creates an unique dates list from DataTbl,
containing
column Date
Application.StatusBar = "Refreshing Dates list ..."
Set qtQtrResults = Worksheets("Dates").QueryTables(1)
ThisWorkbook.Sheets("Dates").Activate
ActiveSheet.Range("A1").Select
With qtQtrResults
.CommandType = xlCmdSql
.Refresh
End With
' ***** Here is my attempt to find a solution *****
' Wait some time for queries and calculations to be finished
WaitTime = "0:" & _
Format(IIf(Int(varSummaryRows / (50 * 60)) < 2,
Int(varSummaryRows / (50 * 60)), 5), "00") & _
":" & Format(Int((varSummaryRows Mod 50 * 60) / 50),
"00")
Application.StatusBar = "Waiting " & WaitTime & " for queries to
be
finished ..."
Application.Wait (Now + TimeValue(WaitTime))
' Recalculate articles last prices
Application.StatusBar = "Recalculating last prices in article
list
...."
varArtRows = [ArtRows]
ThisWorkbook.Sheets("Data").Activate
For i = 2 To varArtRows
If ThisWorkbook.Sheets("Articles").Range("A" & i).Value = ""
Then
ThisWorkbook.Sheets("Articles").Range(i & ":" &
i).Delete
Shift:=xlUp
i = i - 1
Else
varArt = ThisWorkbook.Sheets("Articles").Range("A" &
i).Value
varPrevPrice = ""
varLastPrice = ""
varDiff = ""
If [PrevDate] < "" Then
' PrevDate is a named range defined as
<=IF(ISERROR(LARGE(DatesList;2));"";LARGE(DatesLis t;2))
' DatesList is a named range defined as
<=OFFSET(Dates!$A$1;1;;COUNTIF(Dates!$A:$A;"<")-1;1)
' ***** Here goes it wrong way. P.e. when PrevDate was
<
"", but must now be = "", the IF is processed
' The named range PrevStart (row number of 1st
occurrence of
PrevDate) has been refreshed at this time,
' and instead of row number returns "" - so
ActiveSheet.Range returns an error.
y =
ThisWorkbook.Sheets("Data").UsedRange.Find(varArt,
ActiveSheet.Range("A" & [PrevStart]), xlValues, xlWhole).Row
If ThisWorkbook.Sheets("Data").Range("A" &
[PrevStart]).Value = ThisWorkbook.Sheets("Data").Range("A" & y).Value
Then
varPrevPrice =
ThisWorkbook.Sheets("Data").Range("E"
& y).Value
End If
End If
If [LastDate] < "" Then
' ***** Similar with previous IF, but presence of last
date
data is checked
y =
ThisWorkbook.Sheets("Data").UsedRange.Find(varArt,
ActiveSheet.Range("A" & [LastStart]), xlValues, xlWhole).Row
If ThisWorkbook.Sheets("Data").Range("A" &
[LastStart]).Value = ThisWorkbook.Sheets("Data").Range("A" & y).Value
Then
varLastPrice =
ThisWorkbook.Sheets("Data").Range("E"
& y).Value
End If
End If
If varPrevPrice < "" And varLastPrice < "" Then
varDiff = varLastPrice - varPrevPrice
End If
ThisWorkbook.Sheets("Articles").Range("D" & i).Value =
varPrevPrice
ThisWorkbook.Sheets("Articles").Range("E" & i).Value =
varLastPrice
ThisWorkbook.Sheets("Articles").Range("F" & i).Value =
varDiff
End If
Next i
End If
Application.StatusBar = "Done ..."
' Restore status bar
Application.StatusBar = False
Application.DisplayStatusBar = oldstatusbar
ThisWorkbook.Sheets("Report").Activate
End Sub
|