Moderator: 2020vision
by brecki » Thu Aug 26, 2010 10:05 am
by GaryRussell » Thu Aug 26, 2010 10:18 am
by brecki » Thu Aug 26, 2010 3:17 pm
by GaryRussell » Fri Aug 27, 2010 8:16 am
Private Sub calcGreenUp()
Dim r As Integer, i As Integer
Dim selecName As String
Dim stake As Currency, odds As Currency, win As Currency, lose As Currency, diff As Currency, betType As String
Dim idx As Integer
Dim myBetsRange As Range
Dim betRef As String
r = 2
ReDim ifWin(100)
ReDim ifLose(100)
Set myBetsRange = Worksheets("MyBets").Cells
If currentMarket <> Cells(1, 1) Then initMarket
pl = plRange
currentMarket = Cells(1, 1)
Do
' calculate win and lose positions
If myBetsRange.Cells(r, 5).Value = "F" Then
selecName = myBetsRange.Cells(r, 2).Value
idx = getIndex(selecName)
If idx <> -1 Then
betRef = Cells(idx + 5, 20).Value
stake = myBetsRange.Cells(r, 3).Value
odds = myBetsRange.Cells(r, 4).Value
If myBetsRange.Cells(r, 1).Value = betRef Then ' only include last bet made against this selection
If myBetsRange.Cells(r, 6).Value = "B" Then
ifWin(idx) = ifWin(idx) + (stake * (odds - 1))
ifLose(idx) = ifLose(idx) - stake
Else
ifWin(idx) = ifWin(idx) - (stake * (odds - 1))
ifLose(idx) = ifLose(idx) + stake
End If
End If
End If
End If
r = r + 1
Loop Until myBetsRange.Cells(r, 1).Value = ""
' calculate green up stakes
For r = 5 To 50
getIfWinLose Cells(r, 1).Value, win, lose
If win = lose Then
betType = ""
stake = 0
odds = 0
End If
If win > lose Then
betType = "LAY"
diff = win - lose
odds = Cells(r, 8).Value
If odds <> 0 Then
stake = diff / odds
Else
stake = 0
End If
End If
If win < lose Then
betType = "BACK"
diff = lose - win
odds = Cells(r, 6).Value
If odds <> 0 Then
stake = diff / odds
Else
stake = 0
End If
End If
If stake < 0.01 Then
stake = 0
odds = 0
betType = ""
End If
Cells(r, 25).Value = betType
Cells(r, 26).Value = stake
Cells(r, 27).Value = odds
calculateFuturePL r - 4, betType, stake, odds
Next
levelPLRange = pl
End Sub
by brecki » Fri Aug 27, 2010 12:27 pm
by brecki » Fri Aug 27, 2010 12:32 pm
by GaryRussell » Fri Aug 27, 2010 12:35 pm
Option Explicit
Private ifWin() As Currency
Private ifLose() As Currency
Private selecIndex As New Collection
Private plRange As Range, pl As Variant, levelPLRange As Range
Private currentMarket As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count = 16 Then
Application.EnableEvents = False
calcGreenUp
Application.EnableEvents = True
End If
End Sub
Private Sub calcGreenUp()
Dim r As Integer, i As Integer
Dim selecName As String
Dim stake As Currency, odds As Currency, win As Currency, lose As Currency, diff As Currency, betType As String
Dim idx As Integer
Dim myBetsRange As Range
Dim betRef As String
r = 2
ReDim ifWin(100)
ReDim ifLose(100)
Set myBetsRange = Worksheets("MyBets").Cells
If currentMarket <> Cells(1, 1) Then initMarket
pl = plRange
currentMarket = Cells(1, 1)
Do
' calculate win and lose positions
If myBetsRange.Cells(r, 5).Value = "F" Then
selecName = myBetsRange.Cells(r, 2).Value
idx = getIndex(selecName)
If idx <> -1 Then
betRef = Cells(idx + 5, 20).Value
stake = myBetsRange.Cells(r, 3).Value
odds = myBetsRange.Cells(r, 4).Value
If myBetsRange.Cells(r, 1).Value = betRef Then ' only include last bet made against this selection
If myBetsRange.Cells(r, 6).Value = "B" Then
ifWin(idx) = ifWin(idx) + (stake * (odds - 1))
ifLose(idx) = ifLose(idx) - stake
Else
ifWin(idx) = ifWin(idx) - (stake * (odds - 1))
ifLose(idx) = ifLose(idx) + stake
End If
End If
End If
End If
r = r + 1
Loop Until myBetsRange.Cells(r, 1).Value = ""
' calculate green up stakes
For r = 5 To 50
getIfWinLose Cells(r, 1).Value, win, lose
If win = lose Then
betType = ""
stake = 0
odds = 0
End If
If win > lose Then
betType = "LAY"
diff = win - lose
odds = Cells(r, 8).Value
If odds <> 0 Then
stake = diff / odds
Else
stake = 0
End If
End If
If win < lose Then
betType = "BACK"
diff = lose - win
odds = Cells(r, 6).Value
If odds <> 0 Then
stake = diff / odds
Else
stake = 0
End If
End If
If stake < 0.01 Then
stake = 0
odds = 0
betType = ""
End If
Cells(r, 25).Value = betType
Cells(r, 26).Value = stake
Cells(r, 27).Value = odds
calculateFuturePL r - 4, betType, stake, odds
Next
levelPLRange = pl
End Sub
Private Sub calculateFuturePL(r As Integer, betType As String, stake As Currency, odds As Currency)
Dim i As Integer
For i = 1 To UBound(pl)
If betType = "BACK" Then
If i = r Then
pl(i, 1) = pl(i, 1) + (stake * (odds - 1))
Else
pl(i, 1) = pl(i, 1) - stake
End If
Else
If i = r Then
pl(i, 1) = pl(i, 1) - (stake * (odds - 1))
Else
pl(i, 1) = pl(i, 1) + stake
End If
End If
Next
End Sub
Private Sub initMarket()
Dim r As Integer
Set selecIndex = New Collection
r = 5
Do
r = r + 1
Loop Until Cells(r, 1) = ""
Set plRange = Range(Cells(5, 24), Cells(r - 1, 24))
Set levelPLRange = Range(Cells(5, 28), Cells(100, 28))
levelPLRange = ""
Set levelPLRange = Range(Cells(5, 28), Cells(r - 1, 28))
End Sub
Private Function getIndex(selecName As String) As Integer
Dim idx As Integer
Dim r As Integer
Dim found As Boolean
On Error GoTo index_not_found
idx = selecIndex(selecName)
getIndex = idx
Exit Function
index_not_found:
On Error GoTo 0
r = 4
found = False
Do
r = r + 1
If Cells(r, 1).Value = selecName Then
selecIndex.Add r - 5, selecName
found = True
End If
Loop Until found Or Cells(r, 1).Value = ""
If found Then getIndex = r - 5 Else getIndex = -1
End Function
Private Sub getIfWinLose(selecName As String, ByRef win As Currency, ByRef lose As Currency)
Dim idx As Integer
On Error GoTo index_not_found
idx = selecIndex(selecName)
win = ifWin(idx)
lose = ifLose(idx)
Exit Sub
index_not_found:
On Error GoTo 0
win = 0
lose = 0
End Sub
Function getPrevOdds(ByVal odds As Currency) As Currency
Dim oddsInc As Currency
Select Case odds
Case 1.01 To 2
oddsInc = 0.01
Case 2.02 To 3
oddsInc = 0.02
Case 3.05 To 4
oddsInc = 0.05
Case 4.1 To 6
oddsInc = 0.1
Case 6.2 To 10
oddsInc = 0.2
Case 10.5 To 20
oddsInc = 0.5
Case 21 To 30
oddsInc = 1
Case 32 To 50
oddsInc = 2
Case 55 To 100
oddsInc = 5
Case 110 To 1000
oddsInc = 10
End Select
If Math.Round(odds - oddsInc, 2) >= 1.01 Then
getPrevOdds = Math.Round(odds - oddsInc, 2)
Else
getPrevOdds = 1.01
End If
End Function
Function getNextOdds(ByVal odds As Currency) As Currency
Dim oddsInc As Currency
Select Case odds
Case 1 To 1.99
oddsInc = 0.01
Case 2 To 2.98
oddsInc = 0.02
Case 3 To 3.95
oddsInc = 0.05
Case 4 To 5.9
oddsInc = 0.1
Case 6 To 9.8
oddsInc = 0.2
Case 10 To 19.5
oddsInc = 0.5
Case 20 To 29
oddsInc = 1
Case 30 To 48
oddsInc = 2
Case 50 To 95
oddsInc = 5
Case 100 To 1000
oddsInc = 10
End Select
If Math.Round(odds + oddsInc, 2) <= 1000 Then
getNextOdds = Math.Round(odds + oddsInc, 2)
Else
getNextOdds = 1000
End If
End Function
Function plusTicks(odds As Currency, ticks As Byte) As Currency
Dim i As Byte
For i = 1 To ticks
odds = getNextOdds(odds)
Next
plusTicks = odds
End Function
Function minusTicks(odds As Currency, ticks As Byte) As Currency
Dim i As Byte
For i = 1 To ticks
odds = getPrevOdds(odds)
Next
minusTicks = odds
End Function
by brecki » Fri Aug 27, 2010 1:38 pm
by GaryRussell » Mon Aug 30, 2010 9:53 am
brecki wrote:Hi Gary, that works well, but may be you didn´t reed my second post:
Besides it is important that the greening bet depends on the bet reference taken from the MyBets sheet and NOT from column T on Sheet 1, because the bet reference must be cleared by the CLEAR trigger before the greening bet can be triggered, otherwise it won´t be possible to trigger the greening bet as there are no other trigger cells than in the column Q.
Could you solve this for me ? Thx !
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count = 16 Then
Application.EnableEvents = False
calcGreenUp
checkGreenUpTrigger
Application.EnableEvents = True
End If
End Sub
Private Sub checkGreenUpTrigger()
Dim foundCell As Range, i As Integer, lastR As Integer
Set foundCell = Range("Q4")
Do
lastR = foundCell.Row
Set foundCell = Columns(17).Find(What:="GREENUP-CLEAR", After:=foundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=True)
If foundCell Is Nothing Then Exit Do
If foundCell.Row > lastR Then
Cells(foundCell.Row, 29) = Cells(foundCell.Row, 26)
Cells(foundCell.Row, 30) = Cells(foundCell.Row, 27)
Cells(foundCell.Row, 20) = ""
End If
Loop Until foundCell.Row <= lastR
End Sub
by Shaun » Mon Aug 30, 2010 1:48 pm
by GaryRussell » Mon Aug 30, 2010 2:25 pm
Shaun wrote:I am running this code but find it slugish on ny system, i have a clock on my excel but only refreshes every 2 seconds, the sheet the code should be on is that the sheet gruss connects to or the MyBets sheet.
by brecki » Mon Sep 13, 2010 6:14 pm
by GaryRussell » Tue Sep 14, 2010 7:52 am
The strength of Gruss Software is that it’s been designed by one of you, a frustrated sports punter, and then developed by listening to dozens of like-minded enthusiasts.
Gruss is owned and run by brothers Gary and Mark Russell. Gary discovered Betfair in 2004 and soon realised that using bespoke software to place bets was much more efficient than merely placing them through the website.
Gary built his own software and then enhanced its features after trialling it through other Betfair users and reacting to their improvement ideas, something that still happens today.
He started making a small monthly charge so he could work on it full-time and then recruited Mark to help develop the products and Gruss Software was born.
We think it’s the best of its kind and so do a lot of our customers. But you can never stand still in this game and we’ll continue to improve the software if any more great ideas emerge.