1. #1
    seer8
    seer8's Avatar Become A Pro!
    Join Date: 01-18-09
    Posts: 6
    Betpoints: 66

    line changes

    Hello,

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

    https://www.sportsbookreview.com/for...readsheet.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

  2. #2
    Waterstpub87
    Life-Style Arbitrage
    Waterstpub87's Avatar SBR PRO
    Join Date: 09-10-09
    Posts: 2,753
    Betpoints: 511

    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"?
    175 pts

    3-QUESTION
    SBR TRIVIA WINNER 11/09/2017

    BTP
    Week 8
    4-1-0 292 pts


  3. #3
    seer8
    seer8's Avatar Become A Pro!
    Join Date: 01-18-09
    Posts: 6
    Betpoints: 66

    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

  4. #4
    seer8
    seer8's Avatar Become A Pro!
    Join Date: 01-18-09
    Posts: 6
    Betpoints: 66

    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

  5. #5
    Optional
    Optional's Avatar Moderator
    Join Date: 06-10-10
    Posts: 30,211
    Betpoints: 1955

    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?

    SBR Bash
    Punta Cana
    Attendee 2/4/2017


  6. #6
    seer8
    seer8's Avatar Become A Pro!
    Join Date: 01-18-09
    Posts: 6
    Betpoints: 66

    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.

Top