Phil
asked on
Microsoft Excel 2013 Timer issues
I have an excel 2013 application with timer code that fires every 1 second. My code within the timer function executes some functions one of which counts seconds. After 60 seconds have elapsed it writes data to a sheet showing the date/time. Even though the timer is executing every 1 second, by the time it has iterated 60 times, it is adding 6 seconds to each record. How can subtract 6 seconds from the now() function ?
The following shows data written after each 60 second iteration. Each record should end with 48 seconds
12:20:48 PM
12:21:53 PM
12:22:59 PM
12:24:05 PM
12:25:11 PM
12:26:17 PM
12:27:23 PM
12:28:29 PM
12:29:34 PM
This is the code in the module to increment time by one second:
Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
The following shows data written after each 60 second iteration. Each record should end with 48 seconds
12:20:48 PM
12:21:53 PM
12:22:59 PM
12:24:05 PM
12:25:11 PM
12:26:17 PM
12:27:23 PM
12:28:29 PM
12:29:34 PM
This is the code in the module to increment time by one second:
Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
It's possible that your timer code is executing one or more macros or processes that take about 6 seconds to complete.
Please show us the code that is being executed by the timer.
ASKER
thanks for your assistancd, timer code below: It's not pretty, I've been in a hurry
Public Sub Timer()
Dim lRow As Long
If gbTimerOn Then
On Error Resume Next
If blSeconds = True Then '*** code to finish up OHLC after 60 seconds
d = Now()
lRow = Sheets("HIST").Range("S1") + 1
' copies Ticker through Triggers up 1 row
Sheets("DT").Select
Range("A13:g41").Select
Selection.Copy
Range("A12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copies RSI through col "K" up 1 row
Range("i13:k41").Select
Selection.Copy
Range("i12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' end copying one minute old data up 1 row
' update row 41 with new one minute data
Range("A41").Select
Sheets("DT").Range("A41") = Sheets("DT").Range("A2") ' writes symbol from A2
Sheets("DT").Range("B41") = d
Sheets("DT").Range("C41") = O
Sheets("DT").Range("D41") = H
Sheets("DT").Range("E41") = L
Sheets("DT").Range("F41") = Workbooks(1).Sheets("Ticke rs").Range ("Z12")
Sheets("DT").Range("G41") = Sheets("DT").Range("C44") '*** writes number of triggers
Sheets("HIST").Cells(lRow, 1) = Sheets("DT").Range("A41")
Sheets("HIST").Cells(lRow, 2) = Sheets("DT").Range("B41")
Sheets("HIST").Cells(lRow, 3) = Sheets("DT").Range("C41")
Sheets("HIST").Cells(lRow, 4) = Sheets("DT").Range("D41")
Sheets("HIST").Cells(lRow, 5) = Sheets("DT").Range("E41")
Sheets("HIST").Cells(lRow, 6) = Sheets("DT").Range("F41")
Sheets("HIST").Cells(lRow, 7) = Sheets("DT").Range("G41")
Sheets("HIST").Cells(lRow, 8) = Sheets("DT").Range("H41")
Sheets("HIST").Cells(lRow, 9) = Sheets("DT").Range("I41")
Sheets("HIST").Cells(lRow, 10) = Sheets("DT").Range("J41")
Sheets("HIST").Cells(lRow, 11) = Sheets("DT").Range("K41")
' write RSIs
Sheets("HIST").Cells(lRow, 13) = Sheets("DT").Range("R41")
Sheets("HIST").Cells(lRow, 14) = Sheets("DT").Range("V41")
Sheets("HIST").Cells(lRow, 15) = Sheets("DT").Range("Z41")
Sheets("HIST").Cells(lRow, 16) = Sheets("DT").Range("AD41")
' write closes to movering average calculation sheet
Sheets("MA").Cells(lRow + 1, 1) = Sheets("DT").Range("F41")
Sheets("MA").Cells(lRow + 1, 2) = Sheets("DT").Range("B41")
blSeconds = False
O = 0
H = 0
L = 0
C = 0
bSeconds = 0
Else '*** code to write closes every second to populate OHLC data
If O = 0 Then
O = Workbooks(1).Sheets("Ticke rs").Range ("Z12")
H = O
L = O
C = O
Else
Z = Workbooks(1).Sheets("Ticke rs").Range ("Z12")
If Z > H Then
H = Z
End If
If Z < L Then
L = Z
End If
End If
bSeconds = bSeconds + 1
sClose = Workbooks(1).Sheets("Ticke rs").Range ("Z12")
If bSeconds = 60 Then
blSeconds = True
End If
End If
Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
End If
End Sub
Public Sub Timer()
Dim lRow As Long
If gbTimerOn Then
On Error Resume Next
If blSeconds = True Then '*** code to finish up OHLC after 60 seconds
d = Now()
lRow = Sheets("HIST").Range("S1")
' copies Ticker through Triggers up 1 row
Sheets("DT").Select
Range("A13:g41").Select
Selection.Copy
Range("A12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copies RSI through col "K" up 1 row
Range("i13:k41").Select
Selection.Copy
Range("i12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' end copying one minute old data up 1 row
' update row 41 with new one minute data
Range("A41").Select
Sheets("DT").Range("A41") = Sheets("DT").Range("A2") ' writes symbol from A2
Sheets("DT").Range("B41") = d
Sheets("DT").Range("C41") = O
Sheets("DT").Range("D41") = H
Sheets("DT").Range("E41") = L
Sheets("DT").Range("F41") = Workbooks(1).Sheets("Ticke
Sheets("DT").Range("G41") = Sheets("DT").Range("C44") '*** writes number of triggers
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
' write RSIs
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
Sheets("HIST").Cells(lRow,
' write closes to movering average calculation sheet
Sheets("MA").Cells(lRow + 1, 1) = Sheets("DT").Range("F41")
Sheets("MA").Cells(lRow + 1, 2) = Sheets("DT").Range("B41")
blSeconds = False
O = 0
H = 0
L = 0
C = 0
bSeconds = 0
Else '*** code to write closes every second to populate OHLC data
If O = 0 Then
O = Workbooks(1).Sheets("Ticke
H = O
L = O
C = O
Else
Z = Workbooks(1).Sheets("Ticke
If Z > H Then
H = Z
End If
If Z < L Then
L = Z
End If
End If
bSeconds = bSeconds + 1
sClose = Workbooks(1).Sheets("Ticke
If bSeconds = 60 Then
blSeconds = True
End If
End If
Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
End If
End Sub
Is the variable named 'd' used somewhere else outside of this code, if not then just do Sheets("DT").Range("B41") = Now() and I suggest you do it right before the the Else.
Also, give this a try. In it I've turned off screen updating which should speed things up a lot and turned of calculations which might help. I also changed the code so that you don't 'Select' anything. Check it carefully to make sure it still does the same thing.
Finally, in my opinion you should always use meaningful variable names that follow standard (or at least consistent) naming practices. For more information on the subject, please see my A Guide to Writing Understandable and Maintainable VBA Code article.
Also, give this a try. In it I've turned off screen updating which should speed things up a lot and turned of calculations which might help. I also changed the code so that you don't 'Select' anything. Check it carefully to make sure it still does the same thing.
Public Sub Timer()
Dim lRow As Long
Dim wsDT As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wsDT = Sheets("DT")
If gbTimerOn Then
On Error Resume Next 'Why do you have this??
With Sheets("DT")
If blSeconds = True Then '*** code to finish up OHLC after 60 seconds
' d = Now()
lRow = Sheets("HIST").Range("S1") + 1
' copies Ticker through Triggers up 1 row
.Range("A13:g41").Copy
.Range("A12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' copies RSI through col "K" up 1 row
.Range("i13:k41").Copy
.Range("i12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' end copying one minute old data up 1 row
' update row 41 with new one minute data
.Range("A41") = .Range("A2") ' writes symbol from A2
.Range("C41") = O
.Range("D41") = H
.Range("E41") = L
.Range("F41") = Workbooks(1).Sheets("Tickers").Range("Z12")
.Range("G41") = .Range("C44") '*** writes number of triggers
Sheets("HIST").Cells(lRow, 1) = .Range("A41:K41")
' write RSIs
Sheets("HIST").Cells(lRow, 13) = .Range("R41")
Sheets("HIST").Cells(lRow, 14) = .Range("V41")
Sheets("HIST").Cells(lRow, 15) = .Range("Z41")
Sheets("HIST").Cells(lRow, 16) = .Range("AD41")
' write closes to movering average calculation sheet
Sheets("MA").Cells(lRow + 1, 1) = .Range("F41")
Sheets("MA").Cells(lRow + 1, 2) = .Range("B41")
blSeconds = False
O = 0
H = 0
L = 0
C = 0
bSeconds = 0
.Range("B41") = Now()
Else '*** code to write closes every second to populate OHLC data
If O = 0 Then
O = Workbooks(1).Sheets("Tickers").Range("Z12")
H = O
L = O
C = O
Else
Z = Workbooks(1).Sheets("Tickers").Range("Z12")
If Z > H Then
H = Z
End If
If Z < L Then
L = Z
End If
End If
bSeconds = bSeconds + 1
sClose = Workbooks(1).Sheets("Tickers").Range("Z12")
If bSeconds = 60 Then
blSeconds = True
End If
End If
Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
End If
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Finally, in my opinion you should always use meaningful variable names that follow standard (or at least consistent) naming practices. For more information on the subject, please see my A Guide to Writing Understandable and Maintainable VBA Code article.
ASKER
I can't thank you enough Martin for what you have done for me... You are absolutely fantastic and I wish there were something I can do for you beyond the points from the Experts Exchange. Please let me know if you think of anything. I'd like to get you a gift card to your favorite restaurant or something else you might enjoy.
Your code made a significant improvement and the delay is now a consistent 2 seconds. Is there anything I can do to subtract the 2 seconds?
Thank you again!!!!!!!!
Your code made a significant improvement and the delay is now a consistent 2 seconds. Is there anything I can do to subtract the 2 seconds?
Thank you again!!!!!!!!
Thanks for the offer but no gift required.
Public Sub Timer()
Dim lRow As Long
Dim wsDT As Worksheet
Dim wsTickers As Worksheet
Dim wsHist As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wsDT = ThisWorkbook.Sheets("DT")
Set wsHist = ThisWorkbookSheets("HIST")
Set wsMA = ThisWorkbook.Sheets("MA")
Set wsTickers = Workbooks(1).Sheets("Tickers")
If gbTimerOn Then
On Error Resume Next 'Why do you have this??
With Sheets("DT")
If blSeconds = True Then '*** code to finish up OHLC after 60 seconds
' d = Now()
lRow = Sheets("HIST").Range("S1") + 1
' copies Ticker through Triggers up 1 row
.Range("A12:g40").Value = .Range("A13:g41").Value
' copies RSI through col "K" up 1 row
.Range("i12:k40").Value = .Range("i13:k41").Value
' end copying one minute old data up 1 row
' update row 41 with new one minute data
.Range("A41") = .Range("A2") ' writes symbol from A2
.Range("C41") = O
.Range("D41") = H
.Range("E41") = L
.Range("F41") = wsTickers.Range("Z12")
.Range("G41") = .Range("C44") '*** writes number of triggers
wsHist.Cells(lRow, 1) = .Range("A41:K41")
' write RSIs
wsHist.Cells(lRow, 13) = .Range("R41")
wsHist.Cells(lRow, 14) = .Range("V41")
wsHist.Cells(lRow, 15) = .Range("Z41")
wsHist.Cells(lRow, 16) = .Range("AD41")
' write closes to movering average calculation sheet
wsMA.Cells(lRow + 1, 1) = .Range("F41")
wsMA.Cells(lRow + 1, 2) = .Range("B41")
blSeconds = False
O = 0
H = 0
L = 0
C = 0
bSeconds = 0
.Range("B41") = Now()
Else '*** code to write closes every second to populate OHLC data
If O = 0 Then
O = wsTickers.Range("Z12")
H = O
L = O
C = O
Else
Z = wsTickers.Range("Z12")
If Z > H Then
H = Z
End If
If Z < L Then
L = Z
End If
End If
bSeconds = bSeconds + 1
sClose = wsTickers.Range("Z12")
If bSeconds = 60 Then
blSeconds = True
End If
End If
Application.OnTime Now() + TimeValue("00:00:01"), "Timer"
End If
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
ASKER
something strange is happening. It appears that the workbook has become corrupted. Early this morning things were working fine. Now the data is not being written to wsHist and wsMA. No errors are being generated but the code does not execute. I added a "select" statement before the writing code and it passes that code up as well. However when I am in debug mode the sheet is selected but the data is still not being written. To complicate things further the workbook connected via dde to Interactive Brokers Trader Workstation failed to connect and update. I closed it, reopened it with the same result. I rebooted and the same continued. I also have another spreadsheet that I use to speed my login to Interactive Brokers and the code selecting the login text values failed to update. I opened older versions of the login spreadsheet and the dde worksheet and the older versions work. I hate to go back to an older version of my main workbook but that may be my only option. I have done a debug compile which makes no difference.
Have you seen anything like this before? Thanks...
Have you seen anything like this before? Thanks...
ASKER
Ok, I unremmed my original code and it is working so I need to compare. I know your code was working earlier unless I'm cracking up for real...
ASKER
OK I have it working now. I pasted in all the pieced of your send batch of code getting rid of all the selects and copy and pastes. I will pieced the rest of it in after the market close.
Now we only have a one second delay...... wonderful
I'd really like to add code to subtract a second if that is possible... If you have any ideas on that that would be great.
Thanks again for all your assistance...
Now we only have a one second delay...... wonderful
I'd really like to add code to subtract a second if that is possible... If you have any ideas on that that would be great.
Thanks again for all your assistance...
ASKER
I need to slow down, can't even type now.. I meant pieces of your second batch...
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I’m glad I was able to help.
If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.
Marty - Microsoft MVP 2009 to 2017
Experts Exchange Most Valuable Expert (MVE) 2015, 2017
Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
Experts Exchange Top Expert VBA (current)
If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.
Marty - Microsoft MVP 2009 to 2017
Experts Exchange Most Valuable Expert (MVE) 2015, 2017
Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
Experts Exchange Top Expert VBA (current)