Gruss Forum • View topic

by **Ilena** » Thu Dec 30, 2010 8:48 pm

Hi,
I'm having a problem combining the three procedures below and am now not sure if it can be done, or whether I need to attach each to a separate workbook.
Thanks to the great information on here I was able to cobble these together.

The first is to get the maximum and minimum prices since inplay and the second is basically to get the same information, but since my first bet. The third is to get an equivalent of an SP price, as this is for singles tennis.
I have triggers that rely on the number of lines within MyBets, matching of references, matched, etc., so I'd like to keep this all in one workbook, if at all possible.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iRow As Integer
Dim iCol As Integer
Dim cell As Object

For Each cell In Target
iRow = cell.Row
iCol = cell.Column

' Update Max and Min Matched Values from start of inplay
If Cells(2, 5) = "In Play" And iCol = 15 And iRow > 4 And iRow < 7 Then

Application.EnableEvents = False
If IsEmpty(Range("AJ" & iRow).Value) Then Range("AJ" & iRow).Value = 0
If IsEmpty(Range("AI" & iRow).Value) Then Range("AI" & iRow).Value = 1001
If IsEmpty(Range("AH" & iRow).Value) Then Range("AH" & iRow).Value = Range("O" & iRow).Value

If Not IsEmpty(cell.Value) Then
Range("AG" & iRow).Value = Range("O" & iRow).Value
If cell.Value < Range("AI" & iRow).Value And cell.Value > 1 Then Range("AI" & iRow).Value = cell.Value
If cell.Value > Range("AJ" & iRow).Value And cell.Value < 1001 Then Range("AJ" & iRow).Value = cell.Value
End If

Application.EnableEvents = True
End If

Next cell

End Sub

Private Sub Worksheet_Change1(ByVal Target As Range)
Dim iRow As Integer
Dim iCol As Integer
Dim cell As Object

For Each cell In Target
iRow = cell.Row
iCol = cell.Column

' Update Max and Min Matched Values from first bet
If Cells(2, 14) <> 0 And iCol = 15 And iRow > 4 And iRow < 7 Then

Application.EnableEvents = False
If IsEmpty(Range("AD" & iRow).Value) Then Range("AD" & iRow).Value = 0
If IsEmpty(Range("AC" & iRow).Value) Then Range("AC" & iRow).Value = 1001
If IsEmpty(Range("AB" & iRow).Value) Then Range("AB" & iRow).Value = Range("O" & iRow).Value

If Not IsEmpty(cell.Value) Then
Range("AA" & iRow).Value = Range("O" & iRow).Value
If cell.Value < Range("AC" & iRow).Value And cell.Value > 1 Then Range("AC" & iRow).Value = cell.Value
If cell.Value > Range("AD" & iRow).Value And cell.Value < 1001 Then Range("AD" & iRow).Value = cell.Value
End If

Application.EnableEvents = True
End If

Next cell

End Sub

Private Sub Worksheet_Change2(ByVal Target As Range)
If updating Then Exit Sub
updating = True
If Cells(2, 5) = "In Play" Then
If Cells(5, 25) = "" Then Cells(5, 25) = Cells(5, 15)
If Cells(6, 25) = "" Then Cells(6, 25) = Cells(6, 15)
End If
If Cells(2, 5) <> "In Play" And Cells(2, 6) <> "Suspended" Then
Cells(5, 25) = ""
Cells(6, 25) = ""
End If
updating = False
End Sub

Many Thanks and Kind Regards,

Ilena

by **osknows** » Thu Dec 30, 2010 9:22 pm

Hello,

The following code is combines your 3 subs into one using exactly your code

Code: Select all: Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow As Integer Dim iCol As Integer Dim cell As Object Application.EnableEvents = False For Each cell In Target iRow = cell.Row iCol = cell.Column ' Update Max and Min Matched Values from start of inplay If Cells(2, 5) = "In Play" And iCol = 15 And iRow > 4 And iRow < 7 Then If IsEmpty(Range("AJ" & iRow).Value) Then Range("AJ" & iRow).Value = 0 If IsEmpty(Range("AI" & iRow).Value) Then Range("AI" & iRow).Value = 1001 If IsEmpty(Range("AH" & iRow).Value) Then Range("AH" & iRow).Value = Range("O" & iRow).Value If Not IsEmpty(cell.Value) Then Range("AG" & iRow).Value = Range("O" & iRow).Value If cell.Value < Range("AI" & iRow).Value And cell.Value > 1 Then Range("AI" & iRow).Value = cell.Value If cell.Value > Range("AJ" & iRow).Value And cell.Value < 1001 Then Range("AJ" & iRow).Value = cell.Value End If End If '========================== ' Update Max and Min Matched Values from first bet If Cells(2, 14) <> 0 And iCol = 15 And iRow > 4 And iRow < 7 Then If IsEmpty(Range("AD" & iRow).Value) Then Range("AD" & iRow).Value = 0 If IsEmpty(Range("AC" & iRow).Value) Then Range("AC" & iRow).Value = 1001 If IsEmpty(Range("AB" & iRow).Value) Then Range("AB" & iRow).Value = Range("O" & iRow).Value If Not IsEmpty(cell.Value) Then Range("AA" & iRow).Value = Range("O" & iRow).Value If cell.Value < Range("AC" & iRow).Value And cell.Value > 1 Then Range("AC" & iRow).Value = cell.Value If cell.Value > Range("AD" & iRow).Value And cell.Value < 1001 Then Range("AD" & iRow).Value = cell.Value End If End If Next cell '========================== If updating Then Application.EnableEvents = True Exit Sub Else updating = True If Cells(2, 5) = "In Play" Then If Cells(5, 25) = "" Then Cells(5, 25) = Cells(5, 15) If Cells(6, 25) = "" Then Cells(6, 25) = Cells(6, 15) End If If Cells(2, 5) <> "In Play" And Cells(2, 6) <> "Suspended" Then Cells(5, 25) = "" Cells(6, 25) = "" End If updating = False End If Application.EnableEvents = True End Sub

Although the line
If updating Then

will always be FALSE as 'updating' is not stored as a global variable and events have been turned off. This will still work

Code: Select all: Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow As Integer Dim iCol As Integer Dim cell As Object Application.EnableEvents = False For Each cell In Target iRow = cell.Row iCol = cell.Column ' Update Max and Min Matched Values from start of inplay If Cells(2, 5) = "In Play" And iCol = 15 And iRow > 4 And iRow < 7 Then If IsEmpty(Range("AJ" & iRow).Value) Then Range("AJ" & iRow).Value = 0 If IsEmpty(Range("AI" & iRow).Value) Then Range("AI" & iRow).Value = 1001 If IsEmpty(Range("AH" & iRow).Value) Then Range("AH" & iRow).Value = Range("O" & iRow).Value If Not IsEmpty(cell.Value) Then Range("AG" & iRow).Value = Range("O" & iRow).Value If cell.Value < Range("AI" & iRow).Value And cell.Value > 1 Then Range("AI" & iRow).Value = cell.Value If cell.Value > Range("AJ" & iRow).Value And cell.Value < 1001 Then Range("AJ" & iRow).Value = cell.Value End If End If '========================== ' Update Max and Min Matched Values from first bet If Cells(2, 14) <> 0 And iCol = 15 And iRow > 4 And iRow < 7 Then If IsEmpty(Range("AD" & iRow).Value) Then Range("AD" & iRow).Value = 0 If IsEmpty(Range("AC" & iRow).Value) Then Range("AC" & iRow).Value = 1001 If IsEmpty(Range("AB" & iRow).Value) Then Range("AB" & iRow).Value = Range("O" & iRow).Value If Not IsEmpty(cell.Value) Then Range("AA" & iRow).Value = Range("O" & iRow).Value If cell.Value < Range("AC" & iRow).Value And cell.Value > 1 Then Range("AC" & iRow).Value = cell.Value If cell.Value > Range("AD" & iRow).Value And cell.Value < 1001 Then Range("AD" & iRow).Value = cell.Value End If End If Next cell '========================== If Cells(2, 5) = "In Play" Then If Cells(5, 25) = "" Then Cells(5, 25) = Cells(5, 15) If Cells(6, 25) = "" Then Cells(6, 25) = Cells(6, 15) End If If Cells(2, 5) <> "In Play" And Cells(2, 6) <> "Suspended" Then Cells(5, 25) = "" Cells(6, 25) = "" End If Application.EnableEvents = True End Sub

by **Ilena** » Thu Dec 30, 2010 10:25 pm

Wow osknows.

That's so quick. I'll give it a go and try to get my head around the linking. Not that hot on VBA.

Many, Many Thanks,

Ilena

by **osknows** » Thu Dec 30, 2010 11:42 pm

One thing to consider is that your code is reading and writing to each cell one cell at a time using the FOR loop and irow/icol and may be slower than other methods

A quicker way is to read in the 'Target' range once into an array, perform the calcs in the array and write the full array back out once.

If you want to speed things up then read up on VBA arrays and post back if you need some help or advice. There should be loads of examples in this forum too

by **Ilena** » Fri Dec 31, 2010 12:09 am

Many Thanks osknows for the advice.
I will certainly do some reading on arrays, as I use Excel a lot in my work, but don't have to do much with VBA.

Saying that if I can get the basic model to work as it should, albeit slow, then I'll be very pleased as I'm looking at maybe a 20 minute tennis first set with 2 Excel rows. Even so, I've got a lot to learn to be able to contribute back so much as you and others do. I'll speak to you again.

Kindest Regards,

Ilena

Combining procedures

Combining procedures

Who is online

Sports betting software from Gruss Software