I'm building a form that can take the values from the clipboard and auto fill itself.
In order to get the values I use application.ontime to run a macro every two seconds and read the clipboard. The start is done in userform initialize.
That works fine.
Sub Userform_Initialize()
On Error Resume Next
fireTime = Now + TimeValue("00:00:02")
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=True
On Error GoTo 0
End Sub
If I close the userform I added a queryclose to make sure the copy macro stops:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=False
End Sub
Works fine also.
The actual macro is this:
Public fireTime As Date
Sub copy()
On Error GoTo ErrHandler
Dim oData As New DataObject
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
DataObj.GetFromClipboard
strPaste = DataObj.GetText(1)
Row1 = Split(strPaste, vbNewLine)(0)
col = Split(Row1, vbTab)
If UBound(Split(col(14), "-")) = 2 Then
If Len(col(0)) = 7 Then
If Left(col(3), 4) = "4600" Then
oData.SetText Text:=Empty 'Clear
oData.PutInClipboard 'take in the clipboard to empty it
UF_RegistreraVM.TB_LevNr.Text = col(0)
Levnr = col(0)
' ... and so on..
'Line below does not work
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=False
Exit Sub
End If
End If
End If
ErrHandler:
On Error Resume Next
fireTime = Now + TimeValue("00:00:02")
Application.OnTime EarliestTime:=fireTime, Procedure:="copy", Schedule:=True
On Error GoTo 0
End Sub
And the only line that does not work is when I set application.ontime to false in the nested ifs.
That line is the same as the one in queryclose, but it doesn't work here.
When I debug the code errors on that line and due to On Error GoTo ErrHandler it jums down to ErrHandler and sets a new time to run the macro.
What is the issue that with the code, why can't I turn of the ontime inside the ifs?
Module1:
Sub TimeCheck()
Dim ValueTime As Date
Dim SysTime As Date
ValueTime = Sheets("mylinks").Range("A22").Value
SysTime = Now()
If TimeValue(ValueTime) >= TimeValue(SysTime) Then
MsgBox ("Check the Aplication")
End If
End Sub
Private Sub Workbook_open()
alertTime = Now + TimeValue("00:00:05")
Application.OnTime alertTime, "Timecheck"
End Sub
The above code is not working. Can someone help me with this?
I hope someone can help me about problem that i have.
I created workbook than will on opening start few macros:
Refresh_time - runs every second to update time counter
Save_it - saves file on every 30 minutes
Order - runs marco Save_order at specific time, 02, 10 and 18 hours
Also there is few marcos which will close file if there is no activity for 10 minutes.
In both cases, if file is closed due to inactivity or closed manualy, it keeps opening by it self.
Do anybody have idea where i have made mistake?
In ThisWorkbook
Private Sub Workbook_Open()
Refresh_time
Save_it
Order
TimeSetting
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.Save
Stop_
TimeStop
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
TimeStop
TimeSetting
End Sub
In Module1
Public dTimeB, dTimeS, dTimeT1, dTimeT2, dTimeT3, CloseTime As Date
Sub Stop_()
Application.OnTime dTimeB, "Refresh_time", , False
Application.OnTime dTimeS, "Save_it", , False
Application.OnTime dTimeT1, "Save_order", , False
Application.OnTime dTimeT2, "Save_order", , False
Application.OnTime dTimeT3, "Save_order", , False
End Sub
Sub TimeSetting()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=False
On Error GoTo 0
CloseTime = Now() + TimeValue("00:03:00")
Application.OnTime EarliestTime:=CloseTime, Procedure:="SavedAndClose", Schedule:=True
End Sub
Sub TimeStop()
On Error Resume Next
Application.OnTime EarliestTime:=CloseTime, _
Procedure:="SavedAndClose", Schedule:=False
End Sub
Sub SavedAndClose()
ActiveWorkbook.Close Savechanges:=True
End Sub
Sub Refresh_time()
Dim Smena_1, Smena_2, Smena_3 As Date
On Error Resume Next
Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=False
On Error GoTo 0
dTimeB = Now() + TimeValue("00:00:01")
Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=True
Smena_1 = Date + TimeValue("10:00:00")
Smena_2 = Date + TimeValue("18:00:00")
Smena_3 = Date + 1 + TimeValue("02:00:00")
vreme = Date + Time
If vreme < Smena_1 Then
Y = Smena_1 - vreme
Else
If vreme < Smena_2 Then
Y = Smena_2 - vreme
Else
Y = Smena_3 - vreme
End If
End If
Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Pocetna").Vreme_porucivanja.Value = Format(Y, "hh:mm:ss")
Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Pocetna").Za_porucivanje.Value = Application.CountA(Workbooks("Lager MES REO zica_MM.xlsm").Worksheets("Za porucivanje").Range("A:A")) - 1
End Sub
Sub Save_it()
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
On Error Resume Next
Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=False
On Error GoTo 0
dTimeS = Now() + TimeValue("00:10:00")
Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=True
End Sub
Sub Order()
On Error Resume Next
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
On Error GoTo 0
dTimeT1 = TimeValue("02:00:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True
On Error Resume Next
Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=False
On Error GoTo 0
dTimeT2 = TimeValue("10:00:00")
Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=True
On Error Resume Next
Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=False
On Error GoTo 0
dTimeT3 = TimeValue("18:00:00")
Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=True
End Sub
I did as you suggested, but still is not ok (code is updated). Also, when Order macro run, lets say at 10:00, it runs 3 times. Can you help me with this little more?
You are doing most things correct with application.ontime. But there is one thing you should add. Before setting a new ontime delete the previous.
As an example:
dTimeT1 = now() + TimeValue("00:10:00")
Application.OnTime dTimeT1, "Save_order"
I would change that too:
on error resume next ' in case dTimeT1 is not set
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
on error goto 0
dTimeT1 = now() + TimeValue("00:10:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True
Because if dTimeT1 is a time in the future you could end up with two application.ontimes set but you can't remove the previous because your variable has been changed.
So always clear the previous one then set a new. This issue occurs when you run the macro manually.
Specific to your question:
I'm not sure about your stop function. Why do you first set a schedule then remove it?
Why not just?
Sub Stop_()
on error resume next
Application.OnTime EarliestTime:=dTimeB, Procedure:="Refresh_time", Schedule:=False
Application.OnTime EarliestTime:=dTimeS, Procedure:="Save_it", Schedule:=False
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=False
Application.OnTime EarliestTime:=dTimeT2, Procedure:="Save_order", Schedule:=False
Application.OnTime EarliestTime:=dTimeT3, Procedure:="Save_order", Schedule:=False
on error goto 0
End Sub
As an example of how this is an issue:
' set this to some time in future
dTimeT1 = TimeValue("12:00:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True
' we now set a new time
dTimeT1 = TimeValue("12:05:00")
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=True
' we simulate a close of the workbook which should remove the schedule
Application.OnTime EarliestTime:=dTimeT1, Procedure:="Save_order", Schedule:=false
But this code will run at 12:00 anyways because you set two schedules but only removes one.
I have a button assigned to the StopRecordingData sub to cancel both subs and it doesn't. The schedule False doesn't seem to cancel the scheduled subs in que.
Dim NextTime As Double
Sub RecordData()
Dim Interval As Double
Dim cel As Range, Capture As Range
Application.StatusBar = "Recording Started"
Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row
of data
With Worksheets("Journal") 'Record the data on this worksheet
Set cel = .Range("A2") 'First timestamp goes here
Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
cel.Value = Now
cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
End With
NextTime = Now + TimeValue("00:01:00")
Application.OnTime NextTime, "CloseWB"
End Sub
Sub CloseWB()
Application.OnTime NextTime, "RecordData"
ThisWorkbook.Close True
End Sub
Sub StopRecordingData()
Application.StatusBar = "Recording Stopped"
Application.OnTime NextTime, "RecordData", False
Application.OnTime NextTime, "CloseWB", False
End Sub
You must either
use 2 commas in the end or
full method definition of OnTime method
as the syntax of OnTime method has 4 arguments and last 2 are optional.
Application.OnTime EarliestTime, Procedure, [LatestTime],
[Schedule]
Also, for time related variables, prefer DATE over DOUBLE. Hence use this at the top.
Dim NextTime as Date
Sub StopRecordingData()
Application.StatusBar = "Recording Stopped"
Application.OnTime NextTime, "RecordData",, False
Application.OnTime NextTime, "CloseWB",, False
End Sub
Sub StopRecordingData()
Application.StatusBar = "Recording Stopped"
Application.OnTime EarliestTime:=NextTime, Procedure:="RecordData", Schedule:=False
Application.OnTime EarliestTime:=NextTime, Procedure:="CloseWB", Schedule:=False
End Sub
I havew live data feed in excel, now want to record data as shown here:
]
I wrote on code as follows
Option Explicit
Dim SchedRecalc As Date
Sub Recalc()
Range("A1").Value = Format(Now, "dd-mmm-yy")
Range("B1").Value = Format(Time, "hh:mm:ss AM/PM")
Call SetTime
End Sub
Sub SetTime()
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "Recalc"
Application.OnTime SchedRecalc, "Record"
End Sub
Sub Record()
'
' update Macro
'
With Worksheets("Sheet1")
Application.ScreenUpdating = False
Sheet1.Range("A1:A169").Copy _
Destination:=mySheet.Range("E9")
Sheet1.Range("E9:E169").Insert Shift:=xlShiftToRight
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
End With
End Sub
Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc",
Schedule:=False
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Record",
Schedule:=False
End Sub
but following error is coming.. i have disabled all security setting:
]
I successfully ran your code. Make sure the procedure you reference using Application.OnTime is placed into a Module.
You may also double check your last line. Copying and pasting your code didn't make the VBA editor happy.
Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc",
Schedule:=False
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Record",
Schedule:=False
End Sub
It should be on one line.
Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc", Schedule:=False
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Record", Schedule:=False
End Sub