Excel Green Up Sheet

[osknows]

If your happy for me to do so I can have a look at this later this week and optimize both the read & write routine?

[GaryRussell]

If your happy for me to do so I can have a look at this later this week and optimize both the read & write routine?

If you have time that would be great, I can then update our example.

[mak]

Os hi
I have the following code into one of my worksheets

Do you believe that you can optimize it a little (please)
It is a copy - paste from some codes i grab from the forum

Can you also add this in the code to test them?

Application.Calculation = xlCalculationManual

Application.Calculation = xlCalculationAutomatic


i don't know if they should go
before or after ..target column 16

Thanks



*

Dim marketChanging As Boolean, currentMarket 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)

If (Cells(2, 59)) <= 120 Then
.Range("Q2").Value = 0.4
End If

If (Cells(2, 59)) > 120 Then
.Range("Q2").Value = 1
End If

' If (Cells(2, 5)) = "In Play" And Cells(2, 6) = "Suspended" Then
'.Range("Q2").Value = 1
' End If

If (Cells(2, 5)) = "In Play" And Cells(2, 6) = "Closed" Then
If Not marketChanging Then
marketChanging = True
currentMarket = [A1]
.Range("Q2").Value = 1
Else
If [A1] <> currentMarket Then marketChanging = False
End If
End If

If (Cells(2, 5)) = "In Play" And Cells(2, 6) = "Suspended" Then
If Not marketChanging Then
marketChanging = True
currentMarket = [A1]
.Range("Q2").Value = -1
Else
If [A1] <> currentMarket Then marketChanging = False
End If
End If

If (Cells(2, 5)) = "Not In Play" And Cells(2, 6) = "Closed" Then
If Not marketChanging Then
marketChanging = True
currentMarket = [A1]
.Range("Q2").Value = -1
Else
If [A1] <> currentMarket Then marketChanging = False
End If
End If

'''''Garys timer inPlay
'' http://www.gruss-software.co.uk/phpBB2/ ... 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

With Range("t5:t54")
Set c = .Find("CANCELLED", LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
c.Value = ""
Set c = .FindNext(c)
If Not c Is Nothing Then
If c.Address = firstaddress Then c = Nothing
End If
Loop While Not c Is Nothing
End If
End With



Application.EnableEvents = True
End With
End If
End Sub

[Shaun]

I can tell you the code osknows posted made a huge difference and i have a 6 core processor with 4 gig of ram, i am back to normal updates now so more improvement with the code would be fantastic.

[Shaun]

I am having problems getting this to run

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 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
    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


If i replace this with the original code on the greenUp file it should run correct?

Every thing is in the same place as far as where it displays on the sheet correct?

[osknows]

Shaun - I can't see anything wrong with your code, what's the error?

Mak - your code should be quite fast anyway as there aren't many read or writes over a limited range (5 to 55)

This is a slight tidy up to stop redundant code running and using arrays but the speed difference will be minor. I've tried to convert your coe to this in Excel and haven't been able to physically test using BA so apologies in advance for any errors

Code: Select all

Option Explicit

Dim marketChanging As Boolean, currentMarket As String

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim BA_Array() As Variant, increment As Long, c As Object, firstaddress As String

If Target.Columns.Count = 16 Then


    With ThisWorkbook.Sheets(Target.Worksheet.Name)
   
    BA_Array = .Range("A1:BZ55").Value  'read whole block A1:BZ55 Once ONLY (can make as large or small as required)
   
    '.Cells(2, 59) = BA_Array(2,59)
    '.Range("Q2").Value = BA_Array(2,17)
    'Cells(2, 5) = BA_Array(2,5)
    'Cells(2, 6) = BA_Array(2,6)
    '[A1] = BA_Array(1,1)
    'etc
   
   
    If BA_Array(2, 59) <= 120 Then
        BA_Array(2, 17) = 0.4
    Else
        BA_Array(2, 17) = 1
    End If
   
   
    If BA_Array(2, 5) = "In Play" And BA_Array(2, 6) = "" Then
        'do nothing (this is most frequent scenario so stop further IF statements)
   
    ElseIf BA_Array(2, 5) = "In Play" And BA_Array(2, 6) = "Closed" Then
        If Not marketChanging Then
            marketChanging = True
            currentMarket = BA_Array(1, 1)
            .Range("Q2").Value = 1
        Else
            If BA_Array(1, 1) <> currentMarket Then marketChanging = False
        End If
   
    ElseIf BA_Array(2, 5) = "In Play" And BA_Array(2, 6) = "Suspended" Then
        If Not marketChanging Then
            marketChanging = True
            currentMarket = BA_Array(1, 1)
            .Range("Q2").Value = -1
        Else
            If BA_Array(1, 1) <> currentMarket Then marketChanging = False
        End If
   
    ElseIf BA_Array(2, 5) = "Not In Play" And BA_Array(2, 6) = "Closed" Then
        If Not marketChanging Then
            marketChanging = True
            currentMarket = BA_Array(1, 1)
            .Range("Q2").Value = -1
        Else
            If BA_Array(1, 1) <> currentMarket Then marketChanging = False
        End If
    End If
   
   
    '''''Garys timer inPlay
    '' http://www.gruss-software.co.uk/phpBB2/viewtopic.php?t=2404&highlight=cells
    If BA_Array(2, 5) <> "In Play" And BA_Array(2, 6) <> "Suspended" Then
        .Cells(1, 27) = ""
        .Cells(1, 28) = ""
       
    ElseIf BA_Array(2, 5) = "In Play" Then
        If BA_Array(1, 27) = "" Then
            .Cells(1, 27) = BA_Array(2, 3)
            BA_Array(1, 27) = BA_Array(2, 3)
        End If
        If BA_Array(1, 27) <> "" Then .Cells(1, 28) = DateDiff("s", BA_Array(1, 27), BA_Array(2, 3))
    End If
   
   
    'this is quickest method for searching range
    With .Range("T5:T55")
        Set c = .Find("CANCELLED", LookIn:=xlValues)
        If Not c Is Nothing Then
                firstaddress = c.Address
            Do
                c.Value = ""
                Set c = .FindNext(c)
                If Not c Is Nothing Then
                    If c.Address = firstaddress Then c = Nothing
                End If
            Loop While Not c Is Nothing
        End If
    End With
   
   
   
   
    End With
End If
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub


[Shaun]

I am not getting an error it just fails to run, the original code runs, but runs slow.

I can't get your code to run, the only thing i changed from what you posted was

Code: Select all

Set myBetsRange = Worksheets("Market 1_MyBets").Cells
'change to
Set myBetsRange = Worksheets("MyBets").Cells


And i added

Code: Select all

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


In your code listed in the post it was not included.

[mak]

Os hi and thanks
tried your new code but it doesn't change for example the q2 cell here

If BA_Array(2, 59) <= 120 Then
BA_Array(2, 17) = 0.4
Else
BA_Array(2, 17) = 1
End If

in cells 2, 59 cell is Gary formula to display the timer in seconds.It doesn't populate anything. i tried If BA_Array(2, 59).value <= 120 Then

but that's was not the case

[osknows]

Sorry, I was a bit overzealous with the find and replace, it should read

Code: Select all

    If BA_Array(2, 59) <= 120 Then
       .Range("Q2").Value = 0.4
    Else
        .Range("Q2").Value = 1
    End If


[mak]

thanks Os
i think i have too many formulas in my excel and your code i believe helped me...

i have to refine my formulas for sure

[osknows]

I've tweaked Gary's code on the GreenUp.xls file to make it run much quicker under most conditions. There isn't actually much difference in speed between the 2 using the blank template as is but once additional formulae and/or new bets are added the older version does slow down a little. The new version only writes back to the sheet once which was only partially fixed in my ammended code above. Please test and let me know if there are any problems.

GreenUpNew.xls


Also if anyone wants to test the relative speeds of the 2 files here are the old and new versions with a measure of number of ticks it takes to complete the code. I don't recommend using these except for testing. The number of ticks is displayed in the bottom left corner in the Status Bar.
GreenUpOld.xls for TESTING
GreenUpNew for TESTING