line changes

[seer8]

Hello,

I need some help on this spreadsheet as mentioned in this thread by non other than Ganchrow himself:

https://www.sportsbookreview.com/forum/handicapper-think-tank/26617-overbets-line-changes-kelly-spreadsheet.html

Whenever I change one of the highlighted cells in the spreadsheet, it tells me that there is a compile error. Whenever i click on "calculate stakes", it says there is a compile error. Since I have solver installed, when i click on solver in excel, its says the document is protected or shared.

How can I get this spreadsheet to work? The worksheet is in the thread itself from the link above

[Waterstpub87]

That indicates that something is wrong with the code.

Go to Developer->Macros or Hit Alt F11 to pull up the macro list
Go to each macro and look for a yellow or red highlight of a line of code
When you see one, this will be an error

You can post the code if you want, maybe something got change and is broken.

I don't know about the protection. Maybe check something in options to enable things to run. Does it have a bar across the top that says "Macros Disabled"?

[seer8]

code

This is the complete code when I pressed ALT+F11.


Option Explicit

'Class Variables
Private mclsOddsStyle As clsOddsStyle

'Named Ranges
Private xlrngOddsStyle As Range
Private xlrngOrigOdds As Range
Private xlrngNewOdds As Range
Private xlrngNewOppOdds As Range
Private xlrngOrigWinP As Range
Private xlrngOrigEdge As Range
Private xlrngOrigPushP As Range
Private xlrngNewWinP As Range
Private xlrngNewEdge As Range
Private xlrngNewPushP As Range

Private xlrngNewStake As Range
Private xlrngNewOppStake As Range

Private xlrngOddsStyleOut As Range
Private xlrngCondWinP As Range
Private xlrngDecOrigOdds As Range
Private xlrngDecNewOdds As Range

Private xlrngImpKellyDiv As Range ' this range is not writeable
Private xlrngOrigIdealStake As Range
Private xlrngAssignedKellyDiv As Range

'package globals
Private mlngLastChangedOrig As Double
Private mlngLastChangedNew As Double
Private mstrPosEdgeRows As String
Private mstrNotPosEdgeRows As String

Private Sub cmdCalculate_Click()
Call DoReset
Call DoSolve
End Sub

Private Sub Worksheet_Activate()
On Local Error GoTo ErrHandler

'Me.Unprotect
Me.Protect , , , , True
Set xlrngOddsStyle = Range("OddsStyle")
Set xlrngOrigOdds = Range("OrigOdds")
Set xlrngNewOdds = Range("NewOdds")
Set xlrngNewOppOdds = Range("NewOppOdds")
Set xlrngOrigWinP = Range("OrigWinP")
Set xlrngOrigEdge = Range("OrigEdge")
Set xlrngOrigPushP = Range("OrigPushP")
Set xlrngNewWinP = Range("NewWinP")
Set xlrngNewEdge = Range("NewEdge")
Set xlrngNewPushP = Range("NewPushP")
Set xlrngNewStake = Range("NewStake")
Set xlrngNewOppStake = Range("NewOppStake")

Set xlrngCondWinP = TempSheet.Range("CondOrigWinP")
Set xlrngOddsStyleOut = TempSheet.Range("OddsStyleOut")
Set xlrngDecOrigOdds = TempSheet.Range("DecOrigOdds")
Set xlrngDecNewOdds = TempSheet.Range("DecNewOdds")

Set xlrngImpKellyDiv = Range("ImpKellyDiv")
Set xlrngOrigIdealStake = Range("OrigIdealStake")
Set xlrngAssignedKellyDiv = Range("AssignedKellyDiv")

If mclsOddsStyle Is Nothing Then Set mclsOddsStyle = New clsOddsStyle
If mclsOddsStyle.shtWorksheet Is Nothing Then Set mclsOddsStyle.shtWorksheet = Me

If mclsOddsStyle.strCurOddsStyle = "" Then mclsOddsStyle.strCurOddsStyle = xlrngOddsStyle.Value

If mlngLastChangedOrig = Empty Then mlngLastChangedOrig = lngLAST_CHANGED_WIN_P
If mlngLastChangedNew = Empty Then mlngLastChangedNew = lngLAST_CHANGED_WIN_P

mstrPosEdgeRows = Range("OrigIdealStake").Row & ":" & Range("ImpKellyDiv").Row
mstrNotPosEdgeRows = Range("AssignedKellyDiv").Row & ":" & Range("AssignedKellyDiv").Row
Exit Sub
ErrHandler:
If Err.Number = 91 Or Err.Number = 9 Then
DoReset
Else
On Local Error GoTo 0
Resume
End If
Exit Sub
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Local Error GoTo ErrHandler
If xlrngImpKellyDiv.Address = Target.Address Then
Cancel = True
If MsgBox("The implied Kelly multiplier is supposed to be modified through the ideal stake." & vbNewLine & vbNewLine & _
"Do you wish to modify the ideal stake to force a particular value of the Kelly multiplier?", _
vbYesNo + vbQuestion, "Implied Kelly multiplier Message") = vbYes Then
Dim Response As String, NewKellyDiv As Double
Let NewKellyDiv = 0

Response = InputBox("Enter Kelly multiplier:", "Kelly multiplier Entry Box")
If IsNumeric(Response) Then NewKellyDiv = CDbl(Response)
If NewKellyDiv <= 0 Then
MsgBox "Kelly multiplier must be greater than 0.", vbOKOnly + vbExclamation
Exit Sub
End If
xlrngOrigIdealStake.Value = "=sbkelly(CondOrigWinP, DecOrigOdds, " & NewKellyDiv & ")"
xlrngAssignedKellyDiv.Value = NewKellyDiv
End If
End If
Exit Sub
ErrHandler:
If Err.Number = 91 Or Err.Number = 9 Then
DoReset
Else
On Local Error GoTo 0
Resume
End If
Exit Sub
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Local Error GoTo ErrHandler

Me.Calculate
DoEvents
If xlrngOddsStyle Is Nothing Then Call Worksheet_Activate
Dim NewEdge As Double, NewWinP As Double

If xlrngOddsStyle.Address = Target.Address Then
With mclsOddsStyle
If LCase(Left(Target.Value, 1)) = "d" And LCase(Target.Value) <> "decimal" Then
Target.Value = "Decimal"
ElseIf LCase(Left(Target.Value, 1)) = "u" And LCase(Target.Value) <> "us" Then
Target.Value = "US"
End If
If Target.Value <> .strCurOddsStyle Then
.strCurOddsStyle = xlrngOddsStyle.Value ' Proprty only changes if new value is valid odds type
If .strCurOddsStyle <> "" Then
xlrngOddsStyleOut.Value = .strCurOddsStyle
Call .ConvertOdds(xlrngOrigOdds)
Call .ConvertOdds(xlrngNewOdds)
Call .ConvertOdds(xlrngNewOppOdds)
Else
Target.Value = .strCurOddsStyle
End If
End If
End With
ElseIf xlrngOrigWinP.Address = Target.Address Or _
(mlngLastChangedOrig = lngLAST_CHANGED_WIN_P And _
(xlrngOrigPushP.Address = Target.Address Or _
xlrngOrigOdds.Address = Target.Address _
) _
) _
Then
If xlrngOrigWinP.Value < 0 Then xlrngOrigWinP.Value = 0
If xlrngOrigWinP.Value > 1 Then xlrngOrigWinP.Value = 1
If xlrngOrigPushP.Value < 0 Then xlrngOrigPushP.Value = 0
If xlrngOrigPushP.Value > 1 Then xlrngOrigPushP.Value = 1
If xlrngOrigWinP.Value + xlrngOrigPushP > 1 Then _
xlrngOrigWinP.Value = 1 - xlrngOrigPushP.Value

' to avoid infinite loop we use temp variable
NewEdge = dblCondWinProbOdds2Edge(xlrngCondWinP, xlrngDecOrigOdds)
If xlrngOrigEdge.Value <> CStr(NewEdge) Then xlrngOrigEdge.Value = CStr(NewEdge)

mlngLastChangedOrig = lngLAST_CHANGED_WIN_P
ElseIf xlrngOrigEdge.Address = Target.Address Or _
(mlngLastChangedOrig = lngLAST_CHANGED_EDGE And _
(xlrngOrigPushP.Address = Target.Address Or _
xlrngOrigOdds.Address = Target.Address _
) _
) _
Then
If xlrngOrigEdge.Value > xlrngDecOrigOdds.Value Then _
xlrngOrigEdge.Value = xlrngDecOrigOdds.Value
If xlrngOrigPushP.Value < 0 Then xlrngOrigPushP.Value = 0
If xlrngOrigPushP.Value > 1 Then xlrngOrigPushP.Value = 1

' to avoid infinite loop we use temp variable
NewWinP = dblEdgeOdds2CondWinProb(xlrngOrigEdge, xlrngDecOrigOdds) * _
(1 - xlrngOrigPushP.Value)
If xlrngOrigWinP.Value <> CStr(NewWinP) Then xlrngOrigWinP.Value = CStr(NewWinP)

mlngLastChangedOrig = lngLAST_CHANGED_EDGE
ElseIf xlrngNewWinP.Address = Target.Address Or _
(mlngLastChangedNew = lngLAST_CHANGED_WIN_P And _
(xlrngNewPushP.Address = Target.Address Or _
xlrngNewOdds.Address = Target.Address _
) _
) _
Then
If xlrngNewWinP.Value < 0 Then xlrngNewWinP.Value = 0
If xlrngNewWinP.Value > 1 Then xlrngNewWinP.Value = 1
If xlrngNewPushP.Value < 0 Then xlrngNewPushP.Value = 0
If xlrngNewPushP.Value > 1 Then xlrngNewPushP.Value = 1
If xlrngNewWinP.Value + xlrngNewPushP > 1 Then _
xlrngNewWinP.Value = 1 - xlrngNewPushP.Value

' to avoid infinite loop we use temp variable
NewEdge = dblCondWinProbOdds2Edge(xlrngNewWinP / (1 - xlrngNewPushP), xlrngDecNewOdds)
If xlrngNewEdge.Value <> CStr(NewEdge) Then xlrngNewEdge.Value = CStr(NewEdge)

mlngLastChangedNew = lngLAST_CHANGED_WIN_P
ElseIf xlrngNewEdge.Address = Target.Address Or _
(mlngLastChangedNew = lngLAST_CHANGED_EDGE And _
(xlrngNewPushP.Address = Target.Address Or _
xlrngNewOdds.Address = Target.Address _
) _
) _
Then
If xlrngNewEdge.Value > xlrngDecNewOdds.Value Then _
xlrngNewEdge.Value = xlrngDecNewOdds.Value
If xlrngNewPushP.Value < 0 Then xlrngNewPushP.Value = 0
If xlrngNewPushP.Value > 1 Then xlrngNewPushP.Value = 1

' to avoid infinite loop we use temp variable
NewWinP = dblEdgeOdds2CondWinProb(xlrngNewEdge, xlrngDecNewOdds) * _
(1 - xlrngNewPushP.Value)
If xlrngNewWinP.Value <> CStr(NewWinP) Then xlrngNewWinP.Value = CStr(NewWinP)

mlngLastChangedNew = lngLAST_CHANGED_EDGE
ElseIf xlrngImpKellyDiv.Address = Target.Address Then
If xlrngImpKellyDiv.Formula <> strKelly_MULTIPLIER_CELL_CONTENT Then
Dim NewKellyDiv As Double
NewKellyDiv = 0
If IsNumeric(xlrngImpKellyDiv.Value) Then NewKellyDiv = CDbl(xlrngImpKellyDiv.Value)
If NewKellyDiv <= 0 Then
MsgBox "Kelly multiplier must be greater than 0.", vbOKOnly + vbExclamation
Else
xlrngOrigIdealStake.Value = "=sbkelly(CondOrigWinP, DecOrigOdds, " & NewKellyDiv & ")"
xlrngAssignedKellyDiv.Value = NewKellyDiv
End If
xlrngImpKellyDiv.Value = strKelly_MULTIPLIER_CELL_CONTENT
End If
End If

If xlrngOrigEdge.Address = Target.Address Or _
xlrngOrigOdds.Address = Target.Address Or _
xlrngNewOdds.Address = Target.Address Or _
xlrngNewOppOdds.Address = Target.Address Or _
xlrngNewWinP.Address = Target.Address Or _
xlrngNewPushP.Address = Target.Address Or _
xlrngNewEdge.Address = Target.Address _
Then
'show or hide appropriate Kelly multiplier row
If xlrngOrigEdge.Address = Target.Address Or _
xlrngOrigOdds.Address = Target.Address Then
If xlrngOrigEdge.Value > 0 Then
If Rows(mstrPosEdgeRows).EntireRow.Hidden <> False Then _
Rows(mstrPosEdgeRows).EntireRow.Hidden = False
If Rows(mstrNotPosEdgeRows).EntireRow.Hidde n <> True Then _
Rows(mstrNotPosEdgeRows).EntireRow.Hidde n = True
Else
If Rows(mstrPosEdgeRows).EntireRow.Hidden <> True Then _
Rows(mstrPosEdgeRows).EntireRow.Hidden = True
If Rows(mstrNotPosEdgeRows).EntireRow.Hidde n <> False Then _
Rows(mstrNotPosEdgeRows).EntireRow.Hidde n = False
End If
End If
If ActiveCell.Address <> xlrngOddsStyle.Address Then
xlrngNewStake.Value = "0"
xlrngNewOppStake.Value = "0"
xlrngNewStake.NumberFormat = "0.0000%;0.0000%;-"
xlrngNewOppStake.NumberFormat = "0.0000%;0.0000%;-"
End If
End If
Exit Sub
ErrHandler:
If Err.Number = 91 Or Err.Number = 9 Then
DoReset
Else
On Local Error GoTo 0
Resume
End If
Exit Sub
End Sub

Private Sub Worksheet_Deactivate()
On Local Error GoTo ErrHandler

Set xlrngOddsStyle = Nothing
Set xlrngOrigOdds = Nothing
Set xlrngNewOdds = Nothing
Set xlrngNewOppOdds = Nothing
Set xlrngOrigWinP = Nothing
Set xlrngOrigEdge = Nothing
Set xlrngOrigPushP = Nothing
Set xlrngNewWinP = Nothing
Set xlrngNewEdge = Nothing
Set xlrngNewPushP = Nothing
Set xlrngNewStake = Nothing
Set xlrngNewOppStake = Nothing

Set xlrngCondWinP = Nothing
Set xlrngOddsStyleOut = Nothing
Set xlrngDecOrigOdds = Nothing
Set xlrngDecNewOdds = Nothing

Set xlrngImpKellyDiv = Nothing
Set xlrngOrigIdealStake = Nothing
Set xlrngAssignedKellyDiv = Nothing
Exit Sub
ErrHandler:
If Err.Number = 91 Or Err.Number = 9 Then
DoReset
Else
On Local Error GoTo 0
Resume
End If
Exit Sub
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Local Error GoTo ErrHandler
xlrngOrigOdds.Borders.LineStyle = 0
xlrngNewOdds.Borders.LineStyle = 0
xlrngNewOppOdds.Borders.LineStyle = 0
xlrngOrigWinP.Borders.LineStyle = 0
xlrngOrigPushP.Borders.LineStyle = 0
xlrngOrigEdge.Borders.LineStyle = 0
xlrngImpKellyDiv.Borders.LineStyle = 0
' xlrngOrigIdealStake.Borders.LineStyle = 0
xlrngOrigWinP.Interior.ColorIndex = lngBGCOLORINDEX_EDITABLE
xlrngOrigWinP.Interior.ColorIndex = lngBGCOLORINDEX_EDITABLE
xlrngOrigPushP.Interior.ColorIndex = lngBGCOLORINDEX_EDITABLE
xlrngOrigEdge.Interior.ColorIndex = lngBGCOLORINDEX_EDITABLE
xlrngImpKellyDiv.Interior.ColorIndex = lngBGCOLORINDEX_EDITABLE
' xlrngOrigIdealStake.Interior.ColorIndex = lngBGCOLORINDEX_EDITABLE

If Target.Address = xlrngOddsStyle.Address Then
xlrngOrigOdds.Borders.LineStyle = 1
xlrngNewOdds.Borders.LineStyle = 1
xlrngNewOppOdds.Borders.LineStyle = 1
ElseIf Target.Address = xlrngOrigWinP.Address Then
xlrngOrigWinP.Borders.LineStyle = 1
xlrngOrigPushP.Borders.LineStyle = 1
xlrngOrigEdge.Borders.LineStyle = 1
xlrngOrigPushP.Interior.ColorIndex = lngBGCOLORINDEX_LINKED_ALLOWED
xlrngOrigEdge.Interior.ColorIndex = lngBGCOLORINDEX_LINKED_NOTALLOWED
ElseIf Target.Address = xlrngOrigPushP.Address Then
xlrngOrigWinP.Borders.LineStyle = 1
xlrngOrigPushP.Borders.LineStyle = 1
xlrngOrigEdge.Borders.LineStyle = 1
xlrngOrigWinP.Interior.ColorIndex = lngBGCOLORINDEX_LINKED_ALLOWED
xlrngOrigEdge.Interior.ColorIndex = lngBGCOLORINDEX_LINKED_ALLOWED
ElseIf Target.Address = xlrngOrigEdge.Address Then
xlrngOrigWinP.Borders.LineStyle = 1
xlrngOrigPushP.Borders.LineStyle = 1
xlrngOrigEdge.Borders.LineStyle = 1
xlrngOrigPushP.Interior.ColorIndex = lngBGCOLORINDEX_LINKED_ALLOWED
xlrngOrigWinP.Interior.ColorIndex = lngBGCOLORINDEX_LINKED_NOTALLOWED
ElseIf Target.Address = xlrngImpKellyDiv.Address Then
xlrngImpKellyDiv.Borders.LineStyle = 1
' xlrngOrigIdealStake.Borders.LineStyle = 1
' xlrngOrigIdealStake.Interior.ColorIndex = lngBGCOLORINDEX_LINKED_NOTALLOWED
ElseIf Target.Address = xlrngOrigIdealStake.Address Then
xlrngImpKellyDiv.Borders.LineStyle = 1
' xlrngOrigIdealStake.Borders.LineStyle = 1
xlrngImpKellyDiv.Interior.ColorIndex = lngBGCOLORINDEX_LINKED_NOTALLOWED
End If
Exit Sub
ErrHandler:
If Err.Number = 91 Or Err.Number = 9 Then
DoReset
Else
On Local Error GoTo 0
Resume
End If
Exit Sub
End Sub

Private Sub DoSolve()
On Local Error GoTo ErrHandler

Dim a As AddIn
Set a = AddIns("Solver Add-In")
a.Installed = True

If a.Installed = True Then
'MsgBox "Solver add-in is installed!"
Else
MsgBox "Solver add-in is not installed!"
Exit Sub
End If

Me.Unprotect
SolverReset
SolverOk SetCell:="ExpUtil", MaxMinVal:=1, ValueOf:="0", ByChange:="NewStake,NewOppStake"

' max bet constraints
SolverAdd CellRef:="NewStake", Relation:=1, FormulaText:="1"
SolverAdd CellRef:="NewOppStake", Relation:=1, FormulaText:="1"
SolverAdd CellRef:="TotalStake", Relation:=1, FormulaText:="1"

' non-negativity constraints
SolverAdd CellRef:="NewStake", Relation:=3, FormulaText:="0"
SolverAdd CellRef:="NewOppStake", Relation:=3, FormulaText:="0"
SolverAdd CellRef:="TotalStake", Relation:=3, FormulaText:="0"

' set solver options
SolverOptions 100, 32767, 0.0000001, False, False, 2, 2, 1, 0, True, 0.00001, True
xlrngNewStake.Value = IIf(Range("NewEdge").Value > 0, 0.01, 0)
xlrngNewOppStake.Value = IIf(Range("NewOppEdge").Value > 0, 0.01, 0)
xlrngNewStake.NumberFormat = "0.0000%"
xlrngNewOppStake.NumberFormat = "0.0000%"
SolverSolve UserFinish:=True
Me.Protect , , , , True
DoEvents
Range("B4").Select
Exit Sub
ErrHandler:
If Err.Number = 91 Or Err.Number = 9 Then
DoReset
Else
On Local Error GoTo 0
Resume
End If
Exit Sub
End Sub

[seer8]

example problems

If I opened the sheet and if I were to changed one of the pink boxes, I would get an error for this which was highlighted:

Private Sub Worksheet_Change(ByVal Target As Range)

If I were to click on "Calculate Stakes", it would give an error with this:

Private Sub DoSolve()

I hope this helps

[Optional]

I bet it is to do with the version of Excel Ganch used at the time.

maybe search for an emulator for your version to act like Excel 2007?

[seer8]

I tried everything from converting the the document to different versions of Excel and it still gives me the same problem. It seems the problem stems from VBA but I have very limited knowledge in that regard. I'm interested in knowing what the stake would be on a new bet IF the original bet I made on a team was X and if the line moved, what would be my new bet on that same team would be.