Excel Green Up Sheet

[Shaun]

I am trying to use the Green Up xls but when if i run the macros the sheet slows down it's calcs to about 2 seconds, thought it was the formulas that i added to the sheet but if i turn of macros it runs fine.

any ideas

[GaryRussell]

No problem updating 5 times per second here.

Do you have many bets on the market?

Have you added your own code or is it exactly as downloaded from our website?

[Shaun]

No extra code just formula, i like to make my sheets nice to look at.

As for bets it is designed to place tick off set bets when conditions are met, the greenup formula only gets used once just before the race starts.

[GaryRussell]

I'm afraid I don't know why it would be slow then. I just know the code should not be that inefficient. If you could send me a copy of a spreadsheet that runs slowly as you describe then I could test it to see if there is some change you haven't noticed. Please email it to admin@gruss-software.co.uk

[Shaun]

It must be formula i have added to the second sheet because i can see Sheet1 updates normally even if i increase the refresh it will update ok, the second sheet only updates every 2 seconds

[Shaun]

I will do some more checking as i don't think it is your code but my formula that is the problem.

[Shaun]

I found my issue, it was to do with conditional formatting in excel i had some numbers change colour under different conditions.

[Shaun]

After taking another look at my sheet i have found the problem with the slow sheet, it is related to adding up the amounts of money bet on each runner.

on the back side rows C,E,G and on the lay side rows I,K,M i am trying to create a WOM calculations to see what side the money is on, but this seams to slow the sheet with the calculation. any ideas how to solve this, do you think a macro to do the calculations will solve this.

[osknows]

It depends what the calcs are. If your WOM calcs only contain standard arithmetic it's unlikely to slow things down.

I found the greenup code to be slower than I liked on an old battered Dell machine when testing a few things last year when my main system was down. I sped up Gary's code by writing the greenup calcs back to the sheet once instead of individually for each horse. It seemed much faster.

This was the amended code; perhaps it may help you?

Code: Select all

Option Explicit


Private ifWin() As Currency
Private ifLose() As Currency
Private greenarray() As Variant
Private selecIndex As New Collection
Private plRange As Range, pl As Variant, levelPLRange As Range
Private currentMarket As String


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
    r = 2
    ReDim ifWin(100)
    ReDim ifLose(100)
    ReDim greenarray(1 To 51, 1 To 3)
    Set myBetsRange = Worksheets("Market 1_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
                stake = myBetsRange.Cells(r, 3).Value
                odds = myBetsRange.Cells(r, 4).Value
                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
        r = r + 1
    Loop Until myBetsRange.Cells(r, 1).Value = ""
    ' calculate green up stakes
    For r = 5 To 55
        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
        greenarray(r - 4, 1) = betType
        greenarray(r - 4, 2) = stake
        greenarray(r - 4, 3) = odds
       
'        Cells(r, 62).Value = betType
'        Cells(r, 63).Value = stake
'        Cells(r, 64).Value = odds
        calculateFuturePL r - 4, betType, stake, odds
    Next
    Range("BJ5:bl55") = greenarray()
    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, 65), Cells(100, 65))
    levelPLRange = ""
    Set levelPLRange = Range(Cells(5, 65), Cells(r - 1, 65))
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


the part that's different is as follows (blue has been added, red removed)

greenarray(r - 4, 1) = betType
greenarray(r - 4, 2) = stake
greenarray(r - 4, 3) = odds

' Cells(r, 62).Value = betType
' Cells(r, 63).Value = stake
' Cells(r, 64).Value = odds
calculateFuturePL r - 4, betType, stake, odds
Next
Range("BJ5:bl55") = greenarray()
levelPLRange = pl

Also the calcs write to range Range("BJ5:bl55") which may need altered

[osknows]

Just another thought, sometimes there may be a need for very complex calcs in Excel (eg array formulas). Generally , everytime VBA writes to an excel sheet a recalculation occurs which can slow things down if there are lots of writes.The amended code above reduces the amount of writes, alternatively if you don't want or cannot optimize formula speed then add

Application.Calculation = xlCalculationManual

Application.Calculation = xlCalculationAutomatic

to the start and end of the worksheet_Change event and the recalc will only occur once the code has completed.

[GaryRussell]

Nice amendment osknows. I hadn't considered the performance implications of writing cell by cell. I should know better

[Shaun]

I will test the above code to see if it helps because any time i add any extra code or formula it starts to get slower, i am down to 3 second delay between updates.

[Shaun]

I noticed that the code you posted that has been removed is different from what is on my sheet.

Code: Select all

Cells(r, 25).Value = betType
Cells(r, 26).Value = stake
Cells(r, 27).Value = odds


[osknows]

That's right, instead

Code: Select all

greenarray(r - 4, 1) = betType
greenarray(r - 4, 2) = stake
greenarray(r - 4, 3) = odds


has been added which writes the data to an array named greenarray then

Code: Select all

Range("BJ5:bl55") = greenarray()


writes the whole array in one go to the range BJ5:BL55

Also, ReDim greenarray(1 To 51, 1 To 3) is included which sets the array size and clears the array to ensure nothing remains from the last code run as it's a GLOBAL variable

[osknows]

Nice amendment osknows. I hadn't considered the performance implications of writing cell by cell. I should know better

It could be even faster if the code Reads the data into an array first but I just added a quick fix which seemed to be satisfactory in speed terms.