who can solve my macro problem ?

Find a developer for your Excel triggered betting needs and advertise your development service here.

Moderator: 2020vision

who can solve my macro problem ?

Postby brecki » Tue Sep 14, 2010 9:25 am

Hi,

I am totally frustrated and hope someone can solve my macro problem.

I have a macro that should do the following:

When the clock is 00:05:49 (and the same on 00:05:48 as sometimes the clock jumps without showing the first time) several cells should get cleared. - This macro part has the name : "DeleteoldCommands" and is based on Sheet1.

When the clock is 00:05:39 (and the same on 00:05:38 as sometimes the clock jumps without showing the first time) the macro should automatically trigger a LAY bet against the favorite depending on a special cell in which a parameter is calculated by formula. This macro part has the name : "StartTradingsignal" and is based on Sheet1.

Both macro parts are included in the worksheet change section.

Then the macro is told to wait for 4 minutes and 19 seconds before the initial bet should be greened automatically whatever the outcome is by sending the command BACK-SP to column Q. What happens here is that a trigger called "GREENUP-CLEAR" (programmed by Gary) is sent to Q5:Q24. This macro part has the name : "GreeningTradingsignal" and is based on Module.

In the backround several macro parts (all programmed by Gary) calculate the correct stake and odds to settle the greening bet.

By appearence of the "GREENUP-CLEAR" trigger in column Q the calculated stake, odd and command (BACK-SP) for the greening will be copied to column AJ, AK and AL and column T (Bet Ref) gets cleared.

Now the trigger command disappears in column Q and the greening command "BACK-SP" will be copied from column AL to column what will trigger the greening bet. This macro part has the name : "CarryOver" and is based on Module.

GreeningTradingsignal and CarryOver are not part of the worksheet change section but are both included in the macro code of "StartTradingsignal" so indirectly they are part of the worksheet change section. May be that´s the problem ???????

THAT ALL WORKS !!!

But instead of stopping now, the macro goes into an endless loop ( I don´t know why) sending the BACK-SP command again and again to column Q and also sending the GREENUP CLEAR command to all ozher cells in column Q. As the Bet Ref cell is filled, that causes no damage at first, but when a new market is loaded the bet ref is cleared and a Back bet on a horse in the new race gets fired ( of course that should not happen). Then the hole Excel file does not respond any more as it is in an endless loop and the cpu is at 100%.

I think it must have something to do with the contents of the worksheet change section (which macro parts must be included here and which must not be here) and maybe the location (Module or Sheet1) of the several macro parts, but I can´t identify the problem.

Please let me know if you need further information or if I should send you my Excel file. I hope, someone can help me, as I have no further ideas.

See the code below !

Thanks very much and best regards

Stefan

---------------------------
Code on Sheet1:
---------------------------

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)
Application.EnableEvents = False
If Target.Columns.Count = 16 Then
calcGreenUp
checkGreenUpTrigger
End If
If Target.Columns.Count >= 1 Then
DeleteoldCommands
StartTradingsignal
End If
Application.EnableEvents = True
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-SP"
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-SP"
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-SP" 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

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, 36) = Cells(foundCell.Row, 26)
Cells(foundCell.Row, 37) = Cells(foundCell.Row, 27)
Cells(foundCell.Row, 38) = Cells(foundCell.Row, 25)
Cells(foundCell.Row, 20) = ""
End If
Loop Until foundCell.Row <= lastR
End Sub

Sub StartTradingsignal()
For i = 5 To 24
Area1 = "Q" & i
Area2 = "AG" & i
On Error GoTo Ende
Time1 = CStr(CVDate(Sheets("Sheet1").Range("D2")))
Time2 = CStr(CVDate(TimeSerial(0, 5, 39)))
On Error GoTo 0
If Time1 = Time2 Then
If Sheets("Sheet1").Range(Area2) = "1" And Sheets("Sheet1").Range("V30") <> "keine Wette" Then
Sheets("Sheet1").Range(Area1) = "LAY"
End If
End If
Next
For i = 5 To 24
Area1 = "Q" & i
Area2 = "AG" & i
On Error GoTo Ende
Time1 = CStr(CVDate(Sheets("Sheet1").Range("D2")))
Time3 = CStr(CVDate(TimeSerial(0, 5, 38)))
On Error GoTo 0
If Time1 = Time3 Then
If Sheets("Sheet1").Range(Area2) = "1" And Sheets("Sheet1").Range("V30") <> "keine Wette" Then
Sheets("Sheet1").Range(Area1) = "LAY"
End If
End If
Next
Area3 = "T5:T24"
If Application.WorksheetFunction.Sum(Range(Area3)) > 0 And Zähler = 0 Then
Application.OnTime Now + TimeValue("00:04:19"), "GreeningTradingsignal"
End If
CarryOver
Zähler = 1
Ende:
End Sub

Sub DeleteoldCommands()
For i = 5 To 24
Area4 = "AL" & i
Area1 = "T" & i
Area2 = "AJ" & i
Area3 = "AK" & i
On Error GoTo Ende
Time1 = CStr(CVDate(Sheets("Sheet1").Range("D2")))
Time2 = CStr(CVDate(TimeSerial(0, 5, 49)))
On Error GoTo 0
If Time1 = Time2 Then
Sheets("Sheet1").Range(Area4) = ""
Sheets("Sheet1").Range(Area1) = ""
Sheets("Sheet1").Range(Area2) = ""
Sheets("Sheet1").Range(Area3) = ""
End If
Next
For i = 5 To 24
Area4 = "AL" & i
Area1 = "T" & i
Area2 = "AJ" & i
Area3 = "AK" & i
On Error GoTo Ende
Time1 = CStr(CVDate(Sheets("Sheet1").Range("D2")))
Time3 = CStr(CVDate(TimeSerial(0, 5, 48)))
On Error GoTo 0
If Time1 = Time3 Then
Sheets("Sheet1").Range(Area4) = ""
Sheets("Sheet1").Range(Area1) = ""
Sheets("Sheet1").Range(Area2) = ""
Sheets("Sheet1").Range(Area3) = ""
End If
Next
Zähler = 0
Zähler_1 = 0
Ende:
End Sub



--------------------
Code on Module:
--------------------

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
Public Zähler As Integer
Public Zähler_1 As Integer

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

Sub GreeningTradingsignal()
Do Until Sheets("Sheet1").Range("E2") <> "Suspended"
Application.Wait Now + TimeValue("00:00:01")
Zähler_1 = Zähler_1 + 1
If Zähler_1 > 19 Then Exit Do
Exit Do
Loop
For d = 5 To 24
Area4 = "Q" & d
Sheets("Sheet1").Range(Area4) = "GREENUP-CLEAR"
Next
End Sub

Sub CarryOver()
Dim foundCell As Range, i As Integer, lastR As Integer
Set foundCell = Range("AL4")
Do
lastR = foundCell.Row
Set foundCell = Columns(38).Find(What:="BACK-SP", 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, 17) = Cells(foundCell.Row, 38)
End If
Loop Until foundCell.Row <= lastR

End Sub
brecki
 
Posts: 44
Joined: Tue Aug 10, 2010 11:55 am

Postby brecki » Tue Sep 14, 2010 9:34 am

anywhere you see 8) the code has the text "8)"
brecki
 
Posts: 44
Joined: Tue Aug 10, 2010 11:55 am

Postby brecki » Tue Sep 14, 2010 9:35 am

lol --- I mean 8) replaces the number "8" and the sign ")"
brecki
 
Posts: 44
Joined: Tue Aug 10, 2010 11:55 am

Postby osknows » Tue Sep 14, 2010 8:54 pm

Does it seem stable then after approx 4 minutes continually loops? What it may be is that your line

Application.OnTime Now + TimeValue("00:04:19"), "GreeningTradingsignal"

calls the sub GreeningTradingsignal outside of the worksheet_change event which turns off events using Application.EnableEvents = False causing the worksheet change event to fire again continually.

I haven't tested it but looks like it could be something related. Have you tried putting a breakpoint on all subs and stepping through when they're triggered?

Os
User avatar
osknows
 
Posts: 946
Joined: Wed Jul 29, 2009 12:01 am

Postby brecki » Tue Sep 14, 2010 9:24 pm

Hi Os,

thx for reply.

If you are right with your idea how can I change the situation? The line you mentioned is part of a macro that is inside the worksheet change section. Do I have to remove the line or replace "GreeningTradingsignal" by something else? And by what? Must I add the GreeningTradingsignal to the worksheet count area or what do you mean???

May be you can copy the hole code and post it again including your changes??? That would be very kind as I lost control about the hole thing.

Many thanks for that !!!!!

When I try to do the macros step by step, then I have the same problem.

Looking forward to hear from you

Regards, Stefan
brecki
 
Posts: 44
Joined: Tue Aug 10, 2010 11:55 am

Postby osknows » Tue Sep 14, 2010 10:18 pm

Try changing the sub named 'GreeningTradingsignal()' to

Code: Select all
Sub GreeningTradingsignal()

Do Until Sheets("Sheet1").Range("E2").Value <> "Suspended"
Application.Wait Now + TimeValue("00:00:01")
Zähler_1 = Zähler_1 + 1
If Zähler_1 > 19 Then Exit Do
Exit Do
Loop
Application.EnableEvents = False
For d = 5 To 24
Area4 = "Q" & d
Sheets("Sheet1").Range(Area4) = "GREENUP-CLEAR"
Next
Application.EnableEvents = True
End Sub


Let me know if that works
User avatar
osknows
 
Posts: 946
Joined: Wed Jul 29, 2009 12:01 am

Postby osknows » Tue Sep 14, 2010 11:03 pm

How many times do you want to call GreeningTradingsignal()?

Your code below is called everytime BA refreshes and Sum(T5:T24)>0 as you reset Zähler=0 also every refresh using sub DeleteoldCommands(). In effect Zähler = 1 does nothing!

Code: Select all
......
Area3 = "T5:T24"
If Application.WorksheetFunction.Sum(Range(Area3)) > 0 And Zähler = 0 Then
Application.OnTime Now + TimeValue("00:04:19"), "GreeningTradingsignal"
End If
CarryOver
Zähler = 1
Ende:
......


Eg if BA refresh rate is 0.2s You will get a stacking of calls to GreeningTradingsignal approx every 0.2s at time 04:19 later. Not sure if that's what's intended? Also if T5:T24 has partial matched references then Sum(T5:T24) may still be 0
User avatar
osknows
 
Posts: 946
Joined: Wed Jul 29, 2009 12:01 am

Postby brecki » Wed Sep 15, 2010 7:37 am

osknows wrote:Try changing the sub named 'GreeningTradingsignal()' to

Code: Select all
Sub GreeningTradingsignal()

Do Until Sheets("Sheet1").Range("E2").Value <> "Suspended"
Application.Wait Now + TimeValue("00:00:01")
Zähler_1 = Zähler_1 + 1
If Zähler_1 > 19 Then Exit Do
Exit Do
Loop
Application.EnableEvents = False
For d = 5 To 24
Area4 = "Q" & d
Sheets("Sheet1").Range(Area4) = "GREENUP-CLEAR"
Next
Application.EnableEvents = True
End Sub


Let me know if that works



Unfortunately that doesn´t help, but may be your second idea is the reason. I´ll try and let you know as soon as possible. Thx !
brecki
 
Posts: 44
Joined: Tue Aug 10, 2010 11:55 am

Postby brecki » Fri Sep 17, 2010 8:54 am

Hi Os,

thank you for your help. All testing for the last two days didn´t solve the problem, but now it works as I deleted nearly every macro part and use formula in the trigger cells.

THX AGAIN !

Regards Stefan
brecki
 
Posts: 44
Joined: Tue Aug 10, 2010 11:55 am


Return to Find an Excel developer

Who is online

Users browsing this forum: No registered users and 8 guests

Sports betting software from Gruss Software


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.