Application ontime running randomly !!

[fxfaraz]

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 :

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

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]

Other clk processes are likely to get in the way unless you have a dedicated machine that does nothing else

 

[DanteAmor]

Try putting the instruction at the end.

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