Q2 cell -1 trigger problem

[josthkko]

I am using a very simple condition on horse racing in play: if a market is closed or if it has been in play for more than 100 seconds and is suspended then put -1 in Q2 to go to the next market. But what happens is the program goes to that next market, but doesn't stop there. Instead it goes to the next one. It happens even if i clear the Q2 cell when the new market opens.I have no idea why this is happening, and the next market is not closed, i think my VB is okay:

Code: Select all

If (List1.Cells(2, 6) = "Suspended" And List1.Cells(1, 28) > 100) Or (List1.Cells(2, 6) = "Closed") Then
    List1.Cells(2, 17) = "-1"
End If


Any help appreciated!

[osknows]

The -1 is being placed twice before BA has a chance to refresh the market

I use the following to forward the quickpicklist when a race ends for horse racing markets; note I turn this on by Setting cell Q1 to "Y"

This goes in each Sheet object BA updates to

Code: Select all

Option Explicit

Dim nextracetrigger As Integer
Dim lastrace As String

Private Sub Worksheet_Change(ByVal Target As Range)
   
If Target.Columns.Count = 16 Then

Application.EnableEvents = False

With ThisWorkbook.Sheets(Target.Worksheet.Name)
    'forward quick pick race on after race ended
    If .Range("E2").Value = "In Play" And .Range("F2").Value = "Suspended" And _
    UCase(.Range("Q1").Value) = "Y" And nextracetrigger = 0 Then
        nextracetrigger = 1
        lastrace = .Range("A1").Value
        .Range("Q2").Value = -1
       
    'forward quick pick race when market closed
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And _
    nextracetrigger = 0 Then
        nextracetrigger = 1
        lastrace = .Range("A1").Value
        .Range("Q2").Value = -1
       
    'update balance when market closed
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And _
    nextracetrigger = 1 Then
        nextracetrigger = 2
        .Range("Q2").Value = -6
       
    'reset refresh to 1 sec if market still closed (i.e. last item in pick list)
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And _
    nextracetrigger = 2 Then
        nextracetrigger = 2
        .Range("Q2").Value = 1
   
    End If
   
    'refresh trigger on market change
    If lastrace <> .Range("A1").Value Then
        nextracetrigger = 0
       
    End If
   
End With
Application.EnableEvents = True
End If

End Sub


[mak]

Os goodmorning
i have a similar code of yours in order to move at the next race which works ok, but i have noticed that if the next market is "Closed" for some reason then the code is not working and i have to mannual move to the next race.

Have you check this code for this situation because i am thinking to replace it

the code is the following
please note that i only need to move to the next market & ideally to add some more code to update the quick pick list in the morning (haven't manage it yet)

thanks

Option Explicit

Dim dtStart As Long
Dim dtEnd As Long
Dim refreshTimes As Collection
Dim elapsedTime As Long
Dim totRefresh As Long
Dim refreshed As Boolean
Dim refreshCount As Long
Dim strArray, rng As Range
Dim i, nextracetrigger As Integer
Dim lastrace As String
Const avgCount As Integer = 10



Private Sub Worksheet_Change(ByVal Target As Range)





If Target.Columns.Count = 16 Then
If Not refreshed Then
refreshed = True
dtStart = GetTickCount
Set refreshTimes = New Collection
refreshCount = 0
Else
dtEnd = GetTickCount
refreshCount = refreshCount + 1
elapsedTime = dtEnd - dtStart
refreshTimes.Add Str(elapsedTime), Str(refreshCount)
totRefresh = totRefresh + elapsedTime
If refreshCount > avgCount Then
totRefresh = totRefresh - Val(refreshTimes(Str(refreshCount - avgCount)))
refreshTimes.Remove (Str(refreshCount - avgCount))
Cells(2, 21).Value = totRefresh / avgCount
End If
dtStart = dtEnd
End If



Application.EnableEvents = False

Cells(2, 10).Value = "U" 'updates balance and exposure


'forward quick pick race on after race ended
If Cells(2, 5).Value = "In Play" And Cells(2, 6).Value = "Suspended" And UCase(Cells(1, 17).Value) = "Y" And nextracetrigger = 0 Then
Application.EnableEvents = False
nextracetrigger = 1
lastrace = Cells(1, 1).Value
Cells(2, 17).Value = -1
Application.EnableEvents = True
End If

If lastrace <> Cells(1, 1).Value Then
Application.EnableEvents = False
nextracetrigger = 0
Cells(2, 17).FormulaR1C1 = "=IF(OR(RC[-11]=""Suspended"",RC[-11]=""Closed""),1,IF(ISERROR(IF(AND(HOUR(RC[-13])=0,MINUTE(RC[-13])<=1),0.1,1)),0.1,IF(AND(HOUR(RC[-13])=0,MINUTE(RC[-13])<=1),0.1,1)))"
Application.EnableEvents = True
End If


If Range("f2") <> "Suspended" Then
Set rng = Range("a5:bz55")
strArray = rng
For i = 1 To UBound(strArray)

'track lowest lay odds
strArray(i, 70) = strArray(i, '8 is col H, 70 is unused array address
Select Case strArray(i, 52) '52 is col AZ
Case "", Is > strArray(i,
If strArray(i, <> 0 Then
strArray(i, 70) = strArray(i,
Else
strArray(i, 70) = 1001
End If
Case Else
strArray(i, 70) = strArray(i, 52)
End Select

Next i
Application.EnableEvents = False
Range("az5:az55").Value = Application.WorksheetFunction.Index(strArray, 0, 70)

Else
Application.EnableEvents = False
Range("az5:az55").Value = 1001
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''Garys timer inPlay
'' http://www.gruss-software.co.uk/forum/v ... ight=cells
If Cells(2, 5) = "In Play" Then
If Cells(1, 27) = "" Then Cells(1, 27) = Cells(2, 3)
If Cells(1, 27) <> "" Then Cells(1, 28) = DateDiff("s", Cells(1, 27), Cells(2, 3))
End If
If Cells(2, 5) <> "In Play" And Cells(2, 6) <> "Suspended" Then
Cells(1, 27) = ""
Cells(1, 28) = ""
End If


Application.EnableEvents = True
End If

End Sub

Sub xgd()
Application.EnableEvents = True
End Sub


sorry if i bring trouble to this thread

[osknows]

Hi Mak,

Some of that code looks familiar Hope your well.

Something like this should do what you need. It's untested with BA but should be close

Code: Select all

Option Explicit

Dim dtStart As Long
Dim dtEnd As Long
Dim refreshTimes As Collection
Dim elapsedTime As Long
Dim totRefresh As Long
Dim refreshed, triggerQuickPickListReload, triggerFirstMarketSelect, quickpicklist_trigger As Boolean
Dim refreshCount As Long
Dim strArray, slicestrArray, rng As Range
Dim holdingarray(), BA_Changes() As Variant
Dim i, nextracetrigger, slicestrArray2 As Integer
Dim lastrace As String
Const avgCount As Integer = 10
Const inplayrefresh As Double = 0.2

Private Sub Worksheet_Change(ByVal Target As Range)
Dim start_window, end_window As Date

   If Target.Columns.Count = 16 Then
        If Not refreshed Then
            refreshed = True
            dtStart = GetTickCount
            Set refreshTimes = New Collection
            refreshCount = 0
        Else
            dtEnd = GetTickCount
            refreshCount = refreshCount + 1
            elapsedTime = dtEnd - dtStart
            refreshTimes.Add Str(elapsedTime), Str(refreshCount)
            totRefresh = totRefresh + elapsedTime
            If refreshCount > avgCount Then
                totRefresh = totRefresh - Val(refreshTimes(Str(refreshCount - avgCount)))
                refreshTimes.Remove (Str(refreshCount - avgCount))
                 Application.EnableEvents = False
                ThisWorkbook.Sheets(Target.Worksheet.Name).Cells(2, 21).Value = totRefresh / avgCount
                Application.EnableEvents = True
            End If
            dtStart = dtEnd
        End If



Application.EnableEvents = False

With ThisWorkbook.Sheets(Target.Worksheet.Name)

    .Range("J2").Value = "U" 'updates balance and exposure
   
    '''''Garys timer inPlay
    '' http://www.gruss-software.co.uk/forum/viewtopic.php?t=2404&highlight=cells
    If .Cells(2, 5) = "In Play" Then
    If .Cells(1, 27) = "" Then .Cells(1, 27) = .Cells(2, 3)
    If .Cells(1, 27) <> "" Then .Cells(1, 28) = DateDiff("s", .Cells(1, 27), .Cells(2, 3))
    End If
    If .Cells(2, 5) <> "In Play" And .Cells(2, 6) <> "Suspended" Then
    .Cells(1, 27) = ""
    .Cells(1, 28) = ""
    End If
   
    'update quickpicklist once between set time;
    'set start_window with TimeValue("08:00:00")
    'and end_window TimeValue("08:01:00")
    'gives a window to update if the refresh rate is slower than 1 second. Will only update once during window
    start_window = TimeValue("21:20:00")
    end_window = TimeValue("21:23:00")
   
    If TimeValue(Now()) >= start_window And TimeValue(Now()) <= end_window And quickpicklist_trigger = False Then
        quickpicklist_trigger = True
        triggerQuickPickListReload = True
    ElseIf TimeValue(Now()) < start_window Or TimeValue(Now()) > end_window Then
         quickpicklist_trigger = False
    End If
   
    If triggerQuickPickListReload Then
            triggerQuickPickListReload = False
            .Range("Q2").Value = -3
        triggerFirstMarketSelect = True
    Else
        If triggerFirstMarketSelect Then
            triggerFirstMarketSelect = False
            .Range("Q2").Value = -5
        End If
    End If
       
   
    'forward quick pick race on after race ended
    If .Range("E2").Value = "In Play" And .Range("F2").Value = "Suspended" And UCase(.Range("Q1").Value) = "Y" And _
    Not triggerQuickPickListReload And Not triggerFirstMarketSelect And nextracetrigger = 0 Then
        nextracetrigger = 1
        lastrace = .Range("A1").Value
        .Range("Q2").Value = -1
       
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And nextracetrigger = 0 And _
    Not triggerQuickPickListReload And Not triggerFirstMarketSelect Then
        nextracetrigger = 1
        lastrace = .Range("A1").Value
        .Range("Q2").Value = -1
       
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And nextracetrigger = 1 And _
    Not triggerQuickPickListReload And Not triggerFirstMarketSelect Then
        nextracetrigger = 2
        .Range("Q2").Value = -6
   
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And nextracetrigger = 2 And _
    Not triggerQuickPickListReload And Not triggerFirstMarketSelect Then
        nextracetrigger = 2
        .Range("Q2").Value = 1
   
    End If
   
    If lastrace <> .Range("A1").Value And Not triggerQuickPickListReload And Not triggerFirstMarketSelect Then
        nextracetrigger = 0
        .Range("Q2").FormulaR1C1 = "=IF(OR(RC[-11]=""Suspended"",RC[-11]=""Closed""),1,IF(ISERROR(IF(AND(HOUR(RC[-13])=0,MINUTE(RC[-13])<=1)," & inplayrefresh & ",1))," & inplayrefresh & ",IF(AND(HOUR(RC[-13])=0,MINUTE(RC[-13])<=1)," & inplayrefresh & ",1)))"
    End If
   
           
           
        Set rng = .Range("BA5:BF55")
        strArray = rng
        BA_Changes = Target
       
    If .Range("E2") = "In Play" And .Range("F2") <> "Suspended" Then
       

        For i = 5 To UBound(BA_Changes)
               
                'track lowest lay odds

                strArray(i - 4, 6) = BA_Changes(i, 8) - strArray(i - 4, 5)
                strArray(i - 4, 5) = BA_Changes(i, 8)
               
                Select Case strArray(i - 4, 4)
                Case "", Is > BA_Changes(i, 8)
                If BA_Changes(i, 8) <> 0 Then
                strArray(i - 4, 4) = BA_Changes(i, 8)
                Else
                strArray(i - 4, 4) = 1001
                End If

                End Select
               
               
                'track lowest back odds

                strArray(i - 4, 3) = BA_Changes(i, 6) - strArray(i - 4, 2)
                strArray(i - 4, 2) = BA_Changes(i, 6)
               
                Select Case strArray(i - 4, 1)
                Case "", Is > BA_Changes(i, 6)
                If BA_Changes(i, 6) <> 0 Then
                strArray(i - 4, 1) = BA_Changes(i, 6)
                Else
                strArray(i - 4, 1) = 1001
                End If


                End Select
               
        Next i

    Else

        For i = 1 To UBound(strArray)

                strArray(i, 1) = 1001
                strArray(i, 2) = ""
                strArray(i, 3) = ""
                strArray(i, 4) = 1001
                strArray(i, 5) = ""
                strArray(i, 6) = ""
               
        Next i
       
       
    End If
    .Range("BA5:BF55").Value = strArray
   
End With
Application.EnableEvents = True
End If

End Sub


And this goes in a MODULE

Code: Select all

Public Declare Function GetTickCount Lib "kernel32" () As Long


few notes
Inplay refresh rate is set using Const inplayrefresh As Double = 0.2
The quickpicklist will update once only between whatever is put into
start_window = TimeValue("08:00:00")
end_window = TimeValue("08:01:00")
I've created a 'window' as this is run from the worksheet_change event where a slow refresh rate could miss a single time. The whole thing could be fired using Application.Ontime but this gives an alternative method

I've also amended the track lowest lay odds which now include track lowestback odds. These are output to columns BA5:BF55, change if required

[mak]

Os,
i will try it at the end of the week & will let you know
now i think i understand why the quick pick list didn't update all the time,probably because the time frame (during in play i had set refresh time to 0.1).When the market close (last market at the time list) unfortunally the the q2 cell remained at 0.1

Thanks a lot

[josthkko]

Thank you osknows!
Works like a charm

[mak]

Os hi
just tried your following code
For some reason is not moving to the next race
If you got some time please have a look
Thanks

Hi Mak,

Some of that code looks familiar Hope your well.

Something like this should do what you need. It's untested with BA but should be close

Code: Select all

Option Explicit

Dim dtStart As Long
Dim dtEnd As Long
Dim refreshTimes As Collection
Dim elapsedTime As Long
Dim totRefresh As Long
Dim refreshed, triggerQuickPickListReload, triggerFirstMarketSelect, quickpicklist_trigger As Boolean
Dim refreshCount As Long
Dim strArray, slicestrArray, rng As Range
Dim holdingarray(), BA_Changes() As Variant
Dim i, nextracetrigger, slicestrArray2 As Integer
Dim lastrace As String
Const avgCount As Integer = 10
Const inplayrefresh As Double = 0.2

Private Sub Worksheet_Change(ByVal Target As Range)
Dim start_window, end_window As Date

   If Target.Columns.Count = 16 Then
        If Not refreshed Then
            refreshed = True
            dtStart = GetTickCount
            Set refreshTimes = New Collection
            refreshCount = 0
        Else
            dtEnd = GetTickCount
            refreshCount = refreshCount + 1
            elapsedTime = dtEnd - dtStart
            refreshTimes.Add Str(elapsedTime), Str(refreshCount)
            totRefresh = totRefresh + elapsedTime
            If refreshCount > avgCount Then
                totRefresh = totRefresh - Val(refreshTimes(Str(refreshCount - avgCount)))
                refreshTimes.Remove (Str(refreshCount - avgCount))
                 Application.EnableEvents = False
                ThisWorkbook.Sheets(Target.Worksheet.Name).Cells(2, 21).Value = totRefresh / avgCount
                Application.EnableEvents = True
            End If
            dtStart = dtEnd
        End If



Application.EnableEvents = False

With ThisWorkbook.Sheets(Target.Worksheet.Name)

    .Range("J2").Value = "U" 'updates balance and exposure
   
    '''''Garys timer inPlay
    '' http://www.gruss-software.co.uk/forum/viewtopic.php?t=2404&highlight=cells
    If .Cells(2, 5) = "In Play" Then
    If .Cells(1, 27) = "" Then .Cells(1, 27) = .Cells(2, 3)
    If .Cells(1, 27) <> "" Then .Cells(1, 28) = DateDiff("s", .Cells(1, 27), .Cells(2, 3))
    End If
    If .Cells(2, 5) <> "In Play" And .Cells(2, 6) <> "Suspended" Then
    .Cells(1, 27) = ""
    .Cells(1, 28) = ""
    End If
   
    'update quickpicklist once between set time;
    'set start_window with TimeValue("08:00:00")
    'and end_window TimeValue("08:01:00")
    'gives a window to update if the refresh rate is slower than 1 second. Will only update once during window
    start_window = TimeValue("21:20:00")
    end_window = TimeValue("21:23:00")
   
    If TimeValue(Now()) >= start_window And TimeValue(Now()) <= end_window And quickpicklist_trigger = False Then
        quickpicklist_trigger = True
        triggerQuickPickListReload = True
    ElseIf TimeValue(Now()) < start_window Or TimeValue(Now()) > end_window Then
         quickpicklist_trigger = False
    End If
   
    If triggerQuickPickListReload Then
            triggerQuickPickListReload = False
            .Range("Q2").Value = -3
        triggerFirstMarketSelect = True
    Else
        If triggerFirstMarketSelect Then
            triggerFirstMarketSelect = False
            .Range("Q2").Value = -5
        End If
    End If
       
   
    'forward quick pick race on after race ended
    If .Range("E2").Value = "In Play" And .Range("F2").Value = "Suspended" And UCase(.Range("Q1").Value) = "Y" And _
    Not triggerQuickPickListReload And Not triggerFirstMarketSelect And nextracetrigger = 0 Then
        nextracetrigger = 1
        lastrace = .Range("A1").Value
        .Range("Q2").Value = -1
       
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And nextracetrigger = 0 And _
    Not triggerQuickPickListReload And Not triggerFirstMarketSelect Then
        nextracetrigger = 1
        lastrace = .Range("A1").Value
        .Range("Q2").Value = -1
       
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And nextracetrigger = 1 And _
    Not triggerQuickPickListReload And Not triggerFirstMarketSelect Then
        nextracetrigger = 2
        .Range("Q2").Value = -6
   
    ElseIf .Range("F2").Value = "Closed" And UCase(.Range("Q1").Value) = "Y" And nextracetrigger = 2 And _
    Not triggerQuickPickListReload And Not triggerFirstMarketSelect Then
        nextracetrigger = 2
        .Range("Q2").Value = 1
   
    End If
   
    If lastrace <> .Range("A1").Value And Not triggerQuickPickListReload And Not triggerFirstMarketSelect Then
        nextracetrigger = 0
        .Range("Q2").FormulaR1C1 = "=IF(OR(RC[-11]=""Suspended"",RC[-11]=""Closed""),1,IF(ISERROR(IF(AND(HOUR(RC[-13])=0,MINUTE(RC[-13])<=1)," & inplayrefresh & ",1))," & inplayrefresh & ",IF(AND(HOUR(RC[-13])=0,MINUTE(RC[-13])<=1)," & inplayrefresh & ",1)))"
    End If
   
           
           
        Set rng = .Range("BA5:BF55")
        strArray = rng
        BA_Changes = Target
       
    If .Range("E2") = "In Play" And .Range("F2") <> "Suspended" Then
       

        For i = 5 To UBound(BA_Changes)
               
                'track lowest lay odds

                strArray(i - 4, 6) = BA_Changes(i, 8) - strArray(i - 4, 5)
                strArray(i - 4, 5) = BA_Changes(i, 8)
               
                Select Case strArray(i - 4, 4)
                Case "", Is > BA_Changes(i, 8)
                If BA_Changes(i, 8) <> 0 Then
                strArray(i - 4, 4) = BA_Changes(i, 8)
                Else
                strArray(i - 4, 4) = 1001
                End If

                End Select
               
               
                'track lowest back odds

                strArray(i - 4, 3) = BA_Changes(i, 6) - strArray(i - 4, 2)
                strArray(i - 4, 2) = BA_Changes(i, 6)
               
                Select Case strArray(i - 4, 1)
                Case "", Is > BA_Changes(i, 6)
                If BA_Changes(i, 6) <> 0 Then
                strArray(i - 4, 1) = BA_Changes(i, 6)
                Else
                strArray(i - 4, 1) = 1001
                End If


                End Select
               
        Next i

    Else

        For i = 1 To UBound(strArray)

                strArray(i, 1) = 1001
                strArray(i, 2) = ""
                strArray(i, 3) = ""
                strArray(i, 4) = 1001
                strArray(i, 5) = ""
                strArray(i, 6) = ""
               
        Next i
       
       
    End If
    .Range("BA5:BF55").Value = strArray
   
End With
Application.EnableEvents = True
End If

End Sub


And this goes in a MODULE

Code: Select all

Public Declare Function GetTickCount Lib "kernel32" () As Long


few notes
Inplay refresh rate is set using Const inplayrefresh As Double = 0.2
The quickpicklist will update once only between whatever is put into
start_window = TimeValue("08:00:00")
end_window = TimeValue("08:01:00")
I've created a 'window' as this is run from the worksheet_change event where a slow refresh rate could miss a single time. The whole thing could be fired using Application.Ontime but this gives an alternative method

I've also amended the track lowest lay odds which now include track lowestback odds. These are output to columns BA5:BF55, change if required

[osknows]

Have you turned it on by putting y in cell Q1?

UCase(.Range("Q1").Value) = "Y"

[mak]

Hmm
It is a mirakle

Thanks

[josthkko]

Hmm, another problem arose, if anyone has a similar one. Usually when my bot has went in play i set the refresh rate to 0.1s but for a week or so 0.1s is unavailable, i can only use 0.2s. So is this related to some change in software because of betfair compatibility issues?

[milfor]

When you open BA and log in (and have chosen no market yet) there is a information about that:

Fastest refresh rate increased from 0.1 to 0.2 seconds

Unfortunately we have had to increase the minimum refresh rate. This is to keep the product in line with Betfair’s product requirements. See vendor product requirements for further details. The relevant paragraph is the 4th paragraph in part B under “Data Request Management”. Version 1.1.0.65q includes this modification.

[josthkko]

Oh, thank you for the explanation. I must have missed it because i have my BA running 24/7.