I need to run a large procedure (RunLargeSub) every second, and this procedure takes about 0.5s to complete. I'm currently using Application.OnTime, but won't this result in RunLargeSub being called every ~1.5s ? Is it possible to fix this to 1.0s?
Sub Update()
RunLargeSub
NextTick = Now + TimeValue("00:00:01")
Application.OnTime NextTick, "Update"
End Sub
Sub Stop()
On Error Resume Next
Application.OnTime NextTick, "UpdateClock", , False
On Error GoTo 0
End Sub
All help much appreciated.
You declare NextTick after RunLargeSub. Thats why it takes 1.5s. If you declare it before RunLargeSub it will take exactly 1s. But then you'll have problem if RunLargeSub takes more then 1s because the main sub will stop executing. I'm not sure if onTime accepts fractions of a second but you can do that:
Sub Update()
RunLargeSub
NextTick = Now + TimeValue("00:00:01")/2
Application.OnTime NextTick, "Update"
End Sub
It should run RunLargeSub and in half a second will call the sub again.
Related
I am calling some macros via VBA cod i need some changes in it, i will be thankful if any help could be provided
Sub Button1_Click()
Call moveFilesFromListPartial
Call moveFilesFromListPartial_AA
Call moveAllFilesInDateFolderIfNotExist
Application.OnTime Now + TimeValue("00:01:00"), "Button1_Click"
End Sub
In this current VBA macro all the macros run after one minutes however i request if 3rd macro which is moveAllFilesInDateFolderIfNotExist should run after 5 seconds of first 2 macros. i.e. first 2 macros should be run after 60 seconds and third macro should be run after 65 seconds. this should be the loop every time
i will be grateful
if my understanding is correct, you want to execute macro #3 5 seconds after the 2 first ones where executed.
I suggest to use the Application.Wait method to help you do this:
Sub Button1_Click()
Call moveFilesFromListPartial
Call moveFilesFromListPartial_AA
Application.Wait(Now + TimeValue("00:00:05")) ' 5 seconds to wait
Call moveAllFilesInDateFolderIfNotExist
Application.OnTime Now + TimeValue("00:01:00"), "Button1_Click"
End Sub
You could also import the Sleep method by writing
Public Declare Sub Sleep Lib "kernel32" (ByVal dwmilliseconds As Long)
at the beginning of you module, then calling Sleep 5000 before calling moveAllFilesInDateFolderIfNotExist
Hope this helps
Like this maybe:
Sub Button1_Click()
Application.OnTime Now + TimeValue("00:01:00"), "Part1"
End Sub
Sub Part1()
Call moveFilesFromListPartial
Call moveFilesFromListPartial_AA
'wait 5sec before running the next part
Application.OnTime Now + TimeValue("00:00:05"), "Part2"
End Sub
Sub Part2()
Call moveAllFilesInDateFolderIfNotExist
Application.OnTime Now + TimeValue("00:01:00"), "Part1"
End Sub
I am having difficult interrupting a looped Application.OnTime command. I have a macro I want to periodically loop every 5 seconds (CommandButton221), but then I want to be able to cut the loop off by pressing StopButton.
Private Sub CommandButton221_Click()
If StopMacro = True Then Exit Sub
'[Code that I want looping, not relevant to the question]
testup1
End Sub
Public Sub testup1()
RunWhen = Now + TimeValue("00:00:05")
Application.OnTime RunWhen, "CommandButton221_Click", , True
End Sub
Public Sub StopButton_Click()
StopMacro = True
End Sub
Any suggestions as how to achieve this would be hugely appreciated!
This should do it, a slightly different method, removing the schedule entirely when hitting the Stop button:
Public RunWhen As Double
Private Sub CommandButton221_Click()
Application.StatusBar = Now()
testup1
End Sub
Public Sub testup1()
RunWhen = Now + TimeValue("00:00:05")
Application.OnTime RunWhen, "CommandButton221_Click", , True
End Sub
Public Sub StopButton_Click()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:="CommandButton221_Click", Schedule:=False
End Sub
Make sure the code you have in 221 doesn't take more than 5 seconds to run!
Try using the command DoEvents at the end of testup1() to yield control back to the O.S., which should allow the stop button event to occur. It is very easy for VBA to get stuck in loops with timers and/or heavy data processing and ignore other events.
I looked through every topic I've found in here, but couldn't figure what is wrong with the below.
I am using Application.OnTime to run a Module every minutes. The problem is, when I close the worksheet, Excel reopens the sheet the next time the Macro should run.
I have attempted to use the following fix, to no avail.
Option Explicit
Dim dTime As Date
Public Function AutoRun2()
dTime = Now + TimeValue("00:01:00")
Application.OnTime dTime, "AutoClear"
End Function
Sub StopAutoRun2()
Application.OnTime dTime, "AutoRun2", , False
End Sub
and I have the following in ThisWorkbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopAutoRun
Call StopAutoRun2
End Sub
What am I doing wrong here?
Change "AutoRun2" to "AutoClear" in your stop sub as this is the actual macro that you want to stop being scheduled with the False argument.
I'm using visual basic as I will be studying it soon in college and I was wondering how could I run a sub a certain amount of times a second I have tried using Do Loop whilst calling the function inside the Loop
Do
GameLoop()
Loop Until running = false
I've also tried using a while loop, any help would be great :D
If getting the loop into hundredths of a second is acceptable, then the following would work.
Dim Start As Variant
Do
Start = Timer
GameLoop
Do While (Timer - Start < 0.01)
DoEvents
Loop
Loop Until running = False
If more precision is needed then replace the timer with: How to get time elapsed in milliseconds
If the GameLoop is too slow, then it will run full-speed; otherwise it will run at the desired Loops per second.
DoEvents could be removed if not needed, or you don't like it's event jumbling side effects.
Note this is VB6 code, for the VB.Net millisecond timer check out: How do you get the current time in milliseconds (long), in VB.Net?
Place another loop inside your loop.
In this inner loop you wait for the remaining time, and if there is no time left you continue.
I used the GetTickCount API for this which uses milliseconds as its input althought its accuracy depends on the resolution of the cpu clock
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private mblnRun As Boolean
Private Sub Command1_Click()
StartLoop
End Sub
Private Sub Command2_Click()
StopLoop
End Sub
Private Sub StartLoop()
Dim lngStart As Long
mblnRun = True
Do While mblnRun
'store start time
lngStart = GetTickCount
'do your actions
DoSomething
'wait for the remaining time
Do While GetTickCount < lngStart + 2000
'wait until 2 seconds are passed since the start of this loop cycle
DoEvents
Loop
Loop
End Sub
Private Sub StopLoop()
mblnRun = False
Caption = "Stopped : " & CStr(Now)
End Sub
Private Sub DoSomething()
Caption = "Running : " & CStr(Now)
End Sub
As long as mblnRun is True the loop keeps running
I have a need to run a piece of code every 120 seconds. I am looking for an easy way to do this in VBA. I know that it would be possible to get the timer value from the Auto_Open event to prevent having to use a magic number, but I can't quite get how to fire off a timer to get something to run every 120 seconds.
I don't really want to use an infinite loop with a sleep if I can avoid it.
EDIT:
Cross-post based on an answer provided is at: Excel VBA Application.OnTime. I think its a bad idea to use this... thoughts either way?
When the workbook first opens, execute this code:
alertTime = Now + TimeValue("00:02:00")
Application.OnTime alertTime, "EventMacro"
Then just have a macro in the workbook called "EventMacro" that will repeat it.
Public Sub EventMacro()
'... Execute your actions here'
alertTime = Now + TimeValue("00:02:00")
Application.OnTime alertTime, "EventMacro"
End Sub
Yes, you can use Application.OnTime for this and then put it in a loop. It's sort of like an alarm clock where you keep hittig the snooze button for when you want it to ring again. The following updates Cell A1 every three seconds with the time.
Dim TimerActive As Boolean
Sub StartTimer()
Start_Timer
End Sub
Private Sub Start_Timer()
TimerActive = True
Application.OnTime Now() + TimeValue("00:00:03"), "Timer"
End Sub
Private Sub Stop_Timer()
TimerActive = False
End Sub
Private Sub Timer()
If TimerActive Then
ActiveSheet.Cells(1, 1).Value = Time
Application.OnTime Now() + TimeValue("00:00:03"), "Timer"
End If
End Sub
You can put the StartTimer procedure in your Auto_Open event and change what is done in the Timer proceedure (right now it is just updating the time in A1 with ActiveSheet.Cells(1, 1).Value = Time).
Note: you'll want the code (besides StartTimer) in a module, not a worksheet module. If you have it in a worksheet module, the code requires slight modification.
In Workbook events:
Private Sub Workbook_Open()
RunEveryTwoMinutes
End Sub
In a module:
Sub RunEveryTwoMinutes()
//Add code here for whatever you want to happen
Application.OnTime Now + TimeValue("00:02:00"), "RunEveryTwoMinutes"
End Sub
If you only want the first piece of code to execute after the workbook opens then just add a delay of 2 minutes into the Workbook_Open event
(This is paraphrased from the MS Access help files. I'm sure XL has something similar.) Basically, TimerInterval is a form-level property. Once set, use the sub Form_Timer to carry out your intended action.
Sub Form_Load()
Me.TimerInterval = 1000 '1000 = 1 second
End Sub
Sub Form_Timer()
'Do Stuff
End Sub
I've found that using OnTime can be painful, particularly when:
You're trying to code and the focus on the window gets interrupted
every time the event triggers.
You have multiple workbooks open, you close the one that's supposed to use the timer, and it keeps triggering and reopening the workbook (if you forgot to kill the event properly).
This article by Chip Pearson was very illuminating. I prefer to use the Windows Timer now, instead of OnTime.
My solution:
Option Explicit
Public datHora As Date
Function Cronometro(action As Integer) As Integer
'This return the seconds between two >calls
Cronometro = 0
If action = 1 Then 'Start
datHora = Now
End If
If action = 2 Then 'Time until that moment
Cronometro = DateDiff("s", datHora, Now)
End If
End Function
How to use? Easy...
dummy= Cronometro(1) ' This starts the timer
seconds= Cronometro(2) ' This returns the seconds between the first call and this one