| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel2000 VBA: How force the procedure to wait until queries are refreshed?
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Excel2000 VBA: How force the procedure to wait until queries are r
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| sendkeys(keys,wait) how do I use wait | Excel Discussion (Misc queries) | |||
| Is worksheet 100% refreshed | Excel Programming | |||
| Force Macro to wait till Refreshall is done | Excel Programming | |||
| Force Macro to wait till Refreshall is done | Excel Programming | |||
Linear Mode
