Application ontime running randomly !!

fxfaraz

New Member
Joined
Jun 11, 2019
Messages
1
Hello ,

I have a vba code which captures the data every 20 second from a dynamically changing cell value and stores in the sheet along with some calcuations using Application.Ontime

In the sheet , on checking the difference with the timestamp, show data has been entered at 20 seconds most of the time but on 3 secs , 27 sec , 21 secs , etc randomly

Please help.

My code to call the subroutine :

Code:
Sub Workbook_Open()




Sheets("Sheet1").Cells.Clear
Sheets("Sheet2").Cells.Clear
MsgBox ("Hi,  Be ready ")


Application.OnTime TimeValue("09:00:00"), "Calculator"






End Sub
This is the Subroutine

Code:
Sub Calculator()
Dim i, val1, val2, val3, val4, Checker, Checker1 As Double
Application.OnTime Now + TimeValue("00:00:20"), "Calculator"




i = Worksheets("Sheet2").Range("J1")


'Paste timestamps and Close price


Worksheets("Sheet2").Range("A" & i) = Worksheets("Sheet1").Range("B5")
Worksheets("Sheet2").Range("B" & i) = Worksheets("Sheet1").Range("F2")


'Paste buyers and sellers


Worksheets("Sheet2").Range("F" & i) = Worksheets("Sheet1").Range("N2")
Worksheets("Sheet2").Range("G" & i) = Worksheets("Sheet1").Range("M2")


'Ema calucation
'10 period & 20 period multiplier is different ( 0.1818 for 10 period and 0.0952 for 20 period )




If i = 10 Then
Worksheets("Sheet2").Range("C" & i).Formula = "=AVERAGE(B1:B10)"


ElseIf i > 10 Then
val1 = Worksheets("Sheet2").Range("B" & i)
val2 = Worksheets("Sheet2").Range("C" & i - 1)


Worksheets("Sheet2").Range("C" & i) = val1 * 0.1818 + val2 * (1 - 0.1818)




    If i = 20 Then
    Worksheets("Sheet2").Range("D" & i).Formula = "=AVERAGE(B1:B20)"




    ElseIf i > 20 Then
    val3 = Worksheets("Sheet2").Range("B" & i)
    val4 = Worksheets("Sheet2").Range("C" & i - 1)


    Worksheets("Sheet2").Range("D" & i) = val3 * 0.0952 + val4 * (1 - 0.0952)
    
        If (val1 * 0.1818 + val2 * (1 - 0.1818)) > (val3 * 0.0952 + val4 * (1 - 0.0952)) Then
        Worksheets("Sheet2").Range("E" & i) = "B"
        
        Else
        Worksheets("Sheet2").Range("E" & i) = "S"
        
        End If
        
        
    End If




End If










' Check buyer and sellers and compare


If (Worksheets("Sheet1").Range("N2")) > (Worksheets("Sheet1").Range("M2")) Then
Worksheets("Sheet2").Range("H" & i) = "B"


Else
Worksheets("Sheet2").Range("H" & i) = "S"


End If


'increment counter
Worksheets("Sheet2").Range("J1") = i + 1








End Sub
and here is the sheet showing the different times it has run

https://drive.google.com/open?id=1UJhYZ7ev4mOcFPdxE3c3WAxiBCD_IOph

 

mole999

Moderator
Joined
Oct 23, 2004
Messages
9,899
Other clk processes are likely to get in the way unless you have a dedicated machine that does nothing else
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
8,825
Office Version
2007
Platform
Windows
Try putting the instruction at the end.

Code:
Sub Calculator()
    Dim i, val1, val2, val3, val4, Checker, Checker1 As Double
    
    i = Worksheets("Sheet2").Range("J1")
    'Paste timestamps and Close price
    Worksheets("Sheet2").Range("A" & i) = Worksheets("Sheet1").Range("B5")
    Worksheets("Sheet2").Range("B" & i) = Worksheets("Sheet1").Range("F2")
    'Paste buyers and sellers
    Worksheets("Sheet2").Range("F" & i) = Worksheets("Sheet1").Range("N2")
    Worksheets("Sheet2").Range("G" & i) = Worksheets("Sheet1").Range("M2")
    'Ema calucation
    '10 period & 20 period multiplier is different ( 0.1818 for 10 period and 0.0952 for 20 period )
    If i = 10 Then
        Worksheets("Sheet2").Range("C" & i).Formula = "=AVERAGE(B1:B10)"
    ElseIf i > 10 Then
        val1 = Worksheets("Sheet2").Range("B" & i)
        val2 = Worksheets("Sheet2").Range("C" & i - 1)
        Worksheets("Sheet2").Range("C" & i) = val1 * 0.1818 + val2 * (1 - 0.1818)
        If i = 20 Then
            Worksheets("Sheet2").Range("D" & i).Formula = "=AVERAGE(B1:B20)"
        ElseIf i > 20 Then
            val3 = Worksheets("Sheet2").Range("B" & i)
            val4 = Worksheets("Sheet2").Range("C" & i - 1)
            Worksheets("Sheet2").Range("D" & i) = val3 * 0.0952 + val4 * (1 - 0.0952)
            If (val1 * 0.1818 + val2 * (1 - 0.1818)) > (val3 * 0.0952 + val4 * (1 - 0.0952)) Then
                Worksheets("Sheet2").Range("E" & i) = "B"
            Else
                Worksheets("Sheet2").Range("E" & i) = "S"
            End If
        End If
    End If
    ' Check buyer and sellers and compare
    If (Worksheets("Sheet1").Range("N2")) > (Worksheets("Sheet1").Range("M2")) Then
        Worksheets("Sheet2").Range("H" & i) = "B"
    Else
        Worksheets("Sheet2").Range("H" & i) = "S"
    End If
    'increment counter
    Worksheets("Sheet2").Range("J1") = i + 1
    
[COLOR=#0000ff]    DoEvents[/COLOR]
[COLOR=#0000ff]    Application.OnTime Now + TimeValue("00:00:20"), "Calculator"[/COLOR]
End Sub
 

Forum statistics

Threads
1,082,044
Messages
5,362,847
Members
400,694
Latest member
Ave663

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top