I have a macro that needs to be run for many workbooks. There is a part though where I update a segment of the connection string with unique values and apparently this can't be done in VBA so I must manually do it. Is there a way I can have the Macro do what it does then pause while I update the connection string for say 30 seconds then start running again to completion?
Thanks,
Here is a macro that will allow you 30 seconds to make changes and then resume operation:
Sub dural()
'first part
'do stuff
MsgBox "Perform updates"
t1 = Now
While Now < t1 + TimeSerial(0, 0, 30)
DoEvents
Wend
MsgBox "Resuming the second part of the macro"
'macro does more stuff
End Sub
NOTE:
the DoEvents allows focus to be shared with the user.
Related
I have the following macro. As a short description, every time you select a new cell, it puts a reference text in the status-bar, as a scrolling text. I make it so it does not disrupt user input by using "Do... While loop" with "Do events", will share the code below.
The problem is if i quickly click on multiple cells, it remembers previous loops and runs them all. How can I set the macro to stop running all the loops except for the last one?
Option Explicit
Public STATUSTEXT As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
STATUSTEXT = "Some text valid only for current selection"
'FILL THE TEXT AND GOTO EXIT SUB TO SKIP RELEASING STATUSBAR
charTotal = Len(STATUSTEXT)
charI = 1
Do
charI = charI + 1
Application.statusBar = Right(STATUSTEXT, charI)
DoEvents '# IMPORTANT
Loop Until charI >= charTotal
Application.statusBar = STATUSTEXT
End Sub
Ok I try a better explanation of what actually happens.
Your arrow down triggers the event Worksheet_SelectionChange. Then this macro runs and gets into the loop with DoEvents. This DoEvents allows you to move your cursor again and to do other events. That means your first SelectionChange gets actually halted at DoEvents and second SelectionChange triggers. After this second event is finished you will get back to the DoEvents of the first SelectionChange event and it continues until the end.
So what happens your events get stacked because VBA cannot multi-thread. It just halts the first macro at DoEvents triggers the next event and continues the first event after:
1. SelectionChange
2. SelectionChange
3. SelectionChange
…
3. SelectionChange Ends
2. SelectionChange Ends
1. SelectionChange Ends
So it looks like the first SelectionChange event run last just becaus it run the others in between. Note this is no multi-threading, the code was halted.
The actual issue came from your DoEvents if you remove it. Excel blocks the user interface untile the first SelectionChange event is finished and does not allow to run another event until the first finished. And whoops you will see it ends where your cursor stopped. But it is slow becaus it waits for the event until it performs the next arrow down.
So actually you just need to cancel the first event in case another event run. Try the following:
Option Explicit
Public GlobalStatusText As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim PrivateStatusText As String
PrivateStatusText = "Some text valid only for current selection " & Target.Address
GlobalStatusText = PrivateStatusText
Dim charTotal As Long, charI As Long
charTotal = Len(GlobalStatusText)
charI = 1
Do
charI = charI + 1
Application.StatusBar = Right(GlobalStatusText, charI)
DoEvents '# IMPORTANT
If GlobalStatusText <> PrivateStatusText Then Exit Sub 'cancel because another event run inbetween
Loop Until charI >= charTotal
Application.StatusBar = GlobalStatusText
End Sub
This will cancel the previous events if another event changed the status text in between.
I have a macro that consulte to Database (in this case is a excel workbook), but when the macro consulte to database, it take 30 sec, and the user thinks that the program is broke. I tried with "Application.StatusBar = "Refresh File. "", but the user can´t see the sentence, the best way is a msgbox with the message "Await a moment", and, when the macro is finished, this message is closed. Do you help me with the code? I think the solution is this way:
Sub Button1_Click()
'Call msgbox with message "Await a moment"
Dim x As Long
For x = 0 To 2000000000 Step 1
Next
'The msgbox is closed
End Sub
I think the solution is a msgbox but it is a another option, Go Ahead!
A Msgbox wont work, because it would stop execution of everything until the user clicks OK.
The statusbar would work, if you put a DoEvents right after you set it so the system has a moment to update the screen.
Your only other option would be to create a special form that you show while it's processing, but you would also need a DoEvents after you show it as well.
Sub Test()
' create a userform and name it frmWait
' put whatever you want on that form
' that is what will be displayed while the user waits
frmWait.Show vbModeless
DoEvents
' do your processing here
Unload frmWait
End Sub
Or:
Sub Test()
Application.StatusBar = "Refreshing File. "
DoEvents
' do your processing here
' reset the status bar to normal
Application.StatusBar = ""
End Sub
I have a list of stock prices pulled from Google finance and placed in different sheets in my Excel. I'm wondering, Can I refresh Excel sheet every SECOND (not minute) according to the Google finance stock price?
This can be done without having a macro constantly running. It relies on the Application.OnTime method which allows an action to be scheduled out in the future. I have used this approach to force Excel to refresh data from external sources.
The code below is based nearly exclusively on the code at this link: http://www.cpearson.com/excel/ontime.aspx
The reference for Application.OnTime is at: https://msdn.microsoft.com/en-us/library/office/ff196165.aspx
Dim RunWhen As Date
Sub StartTimer()
Dim secondsBetween As Integer
secondsBetween = 1
RunWhen = Now + TimeSerial(0, 0, secondsBetween)
Application.OnTime EarliestTime:=RunWhen, Procedure:="CodeToRun", Schedule:=True
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="CodeToRun", Schedule:=False
End Sub
Sub EntryPoint()
'you can add other code here to determine when to start
StartTimer
End Sub
Sub CodeToRun()
'this is the "action" part
[A1] = WorksheetFunction.RandBetween(0, 100)
'be sure to call the start again if you want it to repeat
StartTimer
End Sub
In this code, the StartTimer and StopTimer calls are used to manage the Timers. The EntryPoint code gets things started and CodeToRun includes the actual code to run. Note that to make it repeat, you call StartTimer within CodeToRun. This allows it to loop. You can stop the loop by calling the StopTimer or simply not calling StartTimer again. This can be done with some logic in CodeToRun.
I am simply putting a random number in A1 so that you can see it update.
Sub RefreshFormulasEverySecond()
Dim dtTargetTime As Date
Debug.Print "Started"
Do While Range("A1").Value <> "STOP"
Application.Calculate
dtTargetTime = Now + TimeValue("0:00:01")
Do While Now < dtTargetTime
DoEvents
Loop
Debug.Print Now
Loop
Debug.Print "Stopped"
End Sub
You could have this macro running in the background. Paste it into a VBA module. You can run it from there or else put a button on the sheet and use that to trigger it. It's written to stop running when the word "STOP" is typed in cell A1 of whatever sheet the user is looking at.
I'm not sure it's the greatest idea to have a macro running continuously in the background, but that was the only way I could think of.
Hi I am using the following code to parsing some data from website to excel , I need to create a routine in order to update /Refresh the data and keep is up to date and I been advice to start new topic , is big list with multiple sheets so take long time every time excel has to calculate , I hope someone can may help me out
Public Function giveMeValue(ByVal link As Variant) As Variant
Set htm = CreateObject("htmlFile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", link, False
.send
htm.body.innerhtml = .responsetext
End With
If Not htm.getelementbyId("JS_topStoreCount") Is Nothing Then
giveMeValue = htm.getelementbyId("JS_topStoreCount").innerText
Else
giveMeValue = "0"
End If
htm.Close
Set htm = Nothing
End Function
to retrive the value I use =GiveMeValue(A1) and condition formatting the returned value I use the Following code :
Dim color As Integer 'Start Color range
For Each cell In Sheets(1).Range("M4:M5000")
If IsEmpty(cell) Then GoTo nextcell:
If Not IsNumeric(cell.Value) Then GoTo nextcell:
If cell.Value > 14 Then
color = 4
ElseIf cell.Value < 8 Then color = 3
Else: color = 6
End If
cell.Interior.ColorIndex = color
nextcell:
Next cell
End Sub
so as I am not skilled at all with VBA I may unappropriate use the following code to try get refresh it but without result:
Sub Refresh()
Dim WAIT As Double
WAIT = Timer
While Timer < WAIT + 10
DoEvents 'do nothing'
ActiveWorkbook.RefreshAll
Wend
MsgBox "Update Finished Successfully !"
'End Sub
Sounds ambitious. I like it! :)
For a start can you just use conditional formatting? Will be a lot quicker than looping through every cell and changing colour.
Secondly, make your GiveMeValue function "volatile" (http://www.excel-easy.com/vba/examples/volatile-functions.html) so that it refreshes every time you recalculate the page i.e. add a line "application.volatile(true) before anything else in the function.
Thirdly: run your refresh code in the "worksheet_calculate" event and change it to:
Sub Refresh()
Dim WAIT As Double
WAIT = Timer
While Timer < WAIT + 10
DoEvents 'do nothing'
Wend
wsSheet.Calculate
End Sub
So it runs... waits a bit... calculates, then that calculation triggers another wait... etc... Now that your function is volatile, it should refresh all the "getvalue" formulas you have on the current sheet...
And I guess forthly put a "wsSheet.calculate" in the worksheet_activate event to trigger start of that endless loop...
Having said all that, perhaps that endless loop will cause huge issues i.e. mega computer slow down, inability to use computer, and general doom... only one way to find out! The doevents thing should in theory make everything OK. Maybe add if activesheet.codename = "wsSheet" then... so its only running when you're on that sheet...
I have a macro that needs to run for update.
If Excel is in edit, I need a macro to have Excel exit edit mode, that is, take control.
This is not possible as Excel will not run any macros while in cell editing mode.
The natural way to do this is by using the Application.OnTimer method, but it has the "edit problem" you just noted. The called function will not get executed until the user leaves the edit mode.
You may overcome this: This solution is not very efficient, but you may yield control from a macro and regain it from a timer (or any other event you choose).
The following code is from the Excel timer function help.
While the timer is counting down (or you are awaiting other event), you can continue working on your worksheet.
Sub a()
Dim PauseTime, Start, Finish, TotalTime
If (MsgBox("Press Yes to fire update in 1000 secs", 4)) = vbYes Then
PauseTime = 1000 ' Set duration 1000 secs or whatever.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes - THIS IS THE TRICK
Loop
Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.
MsgBox "Paused for " & TotalTime & " seconds" 'Program your update HERE
Else
End
End If
End Sub
You should invoke this macro beforehand, perhaps at the open workbook event.
Also, it is possible to keep the loop going, repeating the update when you want to.
You should check if this strategy does not interfere with other features used in your particular worksheet.