VBA help needed

[lindemann]

I don't have any VBA skills but so far I've muddled through by using or adapting bits of code in sample spreadsheets, etc. I'm now stuck however trying to add this piece of code:

Dim timeInPlay As Date
Dim turnedInPlay As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count = 16 Then
If Range("E2").Value = "In Play" Then
If Not turnedInPlay Then
turnedInPlay = True
timeInPlay = Now
End If
Else
turnedInPlay = False
End If
If turnedInPlay Then Range("T1").Value = DateDiff("s", timeInPlay, Now) Else Range("T1").Value = 0
End If
End Sub

to this existing code in my worksheet:

Dim lastrace As String
Dim nextracetrigger As Integer

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Columns.Count <> 16 Then Exit Sub
Application.EnableEvents = False

With ThisWorkbook.Sheets(Target.Worksheet.Name)

If .Range("R2").Value = -1 And nextracetrigger = 0 Then
lastrace = .Range("A1").Value
.Range("Q2").Value = -1
nextracetrigger = 1

End If

If lastrace <> .Range("A1").Value Then
nextracetrigger = 0
End If
If lastrace <> .Range("A1").Value Then
.Range("Q2").Formula = "=IF(T3<>29,0.2,2)"
End If


End With

Application.EnableEvents = True
End Sub

My crude copy-and-paste attempts have all failed so far and result in the spreadsheet freezing.

How can I combine these two bits of code please?

[negapo]

I dont know why it's freezing, but here is a consolidation of your code, maybe it helps understanding the freeze:

Code: Select all

Dim timeInPlay As Date, turnedInPlay As Boolean
Dim lastRace As String, nextRaceTrigger As Integer


    If Target.Columns.Count <> 16 Then Exit Sub
    Application.EnableEvents = False

    'First Part
    If Range("E2").Value = "In Play" Then
        If turnedInPlay = False Then turnedInPlay = True: timeInPlay = Now
        Range("T1").Value = DateDiff("s", timeInPlay, Now)
    Else
        turnedInPlay = False
        Range("T1").Value = 0
    End If
   
    'Second Part
    If Range("R2").Value = -1 And nextRaceTrigger = 0 Then
        lastRace = Range("A1").Value
        .Range("Q2").Value = -1
        nextRaceTrigger = 1
    Else
        nextRaceTrigger = 0
        Range("Q2").Formula = "=IF(T3<>29,0.2,2)"
    End If

    Application.EnableEvents = True


[lindemann]

Negapo, Thanks for your quick reply and I apologise for my lack of knowledge but copying and pasting your code doesn't work as planned.

As it currently stands, my VBA sheet has an upper portion (General Declarations) and a lower portion (Worksheet Change) divided by a line.
When I copy and paste your code, I only have a General Declarations portion and when I try to link BA to Excel, it sees the Workbook but the Worksheet link is blank so I can't go further.

Am I missing an obvious (to a VBA expert) step?

[negapo]

Sorry, Im not getting your level of VBA.

In my example I have removed this lines:

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
     'My Code Here
End Sub
 

Your code is supposed to be inside a procedure (something like Private Sub). In a Excel file, the VBA part of it is divided in the following manner:
Each Sheet has a place to put some code. In this area you have some events (you can choose the events from the drop down list in the upper section). An event is something that fires up when something happens like "The Sheet is Selected", "The Sheet is updated". When this events occur the code inside that event is executed.
There is also a ThisWorkBook part with events that are not related to the sheets but to the whole workbook.
Then there are modules, that you can add, and put code in it. The code in the modules has to be called on your demand to be executed (you can write something like Call YourSubName).

So "Worksheet_Change" is an event that is inside each one of the worksheets and that is called whenever something changes in that sheet.
Your code is supposed to be inside that so it runs in every refresh of the market prices.

So it would be something like

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

Dim timeInPlay As Date, turnedInPlay As Boolean
Dim lastRace As String, nextRaceTrigger As Integer

    If Target.Columns.Count <> 16 Then Exit Sub
    Application.EnableEvents = False

    'First Part
    If Range("E2").Value = "In Play" Then
        If turnedInPlay = False Then turnedInPlay = True: timeInPlay = Now
        Range("T1").Value = DateDiff("s", timeInPlay, Now)
    Else
        turnedInPlay = False
        Range("T1").Value = 0
    End If
   
    'Second Part
    If Range("R2").Value = -1 And nextRaceTrigger = 0 Then
        lastRace = Range("A1").Value
        .Range("Q2").Value = -1
        nextRaceTrigger = 1
    Else
        nextRaceTrigger = 0
        Range("Q2").Formula = "=IF(T3<>29,0.2,2)"
    End If

    Application.EnableEvents = True
   
End Sub


I could assist you further but Im not understanding the second part of your code.
(Hope Im not being condescending)

[lindemann]

Negapo, Thanks for your continued help and don't worry about being condescending or anything, I need all the help I can get - with VBA problems I'm clueless. There was a stray "." at the start of Second Part, line 3 but I've removed that and got rid of the error messages. The problem now is that the code doesn't work as it should.

Before I get involved in too much VBA detail, the problem I'm trying to address here is is one of blanket triggering of bets when BF turn the market In Play. It seems to me that the API is sometimes very clunky in doing this and I feel I need some extra protection in my spreadsheets.

The First Part of my suggested code puts Time In Play into cell T1 (a nice option to have even if not used) so I can build in a 10 sec delay before my triggers will fire. The combined code is supposed to:

1)Put time In Play into T1.
2)Automatically move to the next race with the Q2=-1 trigger
3)Switch refresh from 2sec to 0.2sec when In Play by changing Q2 value

Is there a better way to achieve these 3 aims? If not, what repairs do I need to this code that I've plucked from elsewhere?

[negapo]

No problem. Well spotted that error.

Im not currently using BA, i believe that when a market closes it says "Closed" in cell E2, if not just change the name.

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

Dim TimeInPlay As Date, TurnedInPlay As Boolean
Dim LastRace As String

    If Target.Columns.Count <> 16 Then Exit Sub
    Application.EnableEvents = False
   
    Select Case Range("E2").Value
        Case "In Play"
            If Range("Q2").Value <> 0.2 Then Range("Q2").Value = 0.2
            If TurnedInPlay = False Then TurnedInPlay = True: TimeInPlay = Now
            Range("T1").Value = DateDiff("s", TimeInPlay, Now)
        Case "Closed"
            LastRace = Range("A1").Value
            Range("Q2").Value = -1
        Case Else
            TurnedInPlay = False
            Range("T1").Value = 0
            If Range("Q2").Value <> 2 Then Range("Q2").Value = 2
    End Select
   
    Application.EnableEvents = True
   
End Sub

I think this code should do the job but without testing it its difficult to know, maybe someone with VBA expertise and BA could check this out.

[negapo]

Just to sum the code:

When the market is open and not inplay Refresh Rate is set to 2
When market turns In Play the refresh rate changes to 0.2 and the timer starts.
When the market closes it goes to the next one in the quick pick list

I was aiming for that with the code.

[lindemann]

Good aiming, now for the results.....

[lindemann]

Hmmmm.....close but not quite a cigar.

The timer doesn't run in T1 but the cell displays a zero which is replaced when deleted so it looks like the "Else" case is running but not "In Play". I can't see any obvious errors.

Using E2=Closed pretty much forces putting each meeting in a separate tab because market close can be some time after the race ends. Using E2=In Play and F2=Suspended picks up the end of the race quicker but doesn't fit with the neat coding structure.

Things to ponder, but I'm away for the weekend so can't do any more until Monday. Thanks again negapo it will be good if this can be fixed but I can't come up with any more ideas right now.