Auto clearing status cells

Example spreadsheets and comments on example spreadsheets.
Dr Ginhog
Posts: 260
Joined: Wed Nov 03, 2010 12:10 am
Location: Ballygarvan,Cork Ireland T12D2VR
Contact:

Potential problem of extra clear_status and extra bet when system suspends before race solved.
Put in extra condition essentially that the racecard data must be unpopulated. It de-populates just before the In-play drops off while suspended so far without fail allowing for the status clearing but not for any (loose Horse) suspension just before race.
AUTOCLEAR_STATUS_Private_SUB.png
BetAngel_1_AUTOCLEARS_STATUS_AT_MKT_CHANGE (V2.1).xls
You do not have the required permissions to view the files attached to this post.
Dr Ginhog
Posts: 260
Joined: Wed Nov 03, 2010 12:10 am
Location: Ballygarvan,Cork Ireland T12D2VR
Contact:

There was Sheet 2 code that I was experimenting with left in that maybe for safety is taken out. I have done this and attached the revised file.Also the is best saved then as an xslm file which is designed specifically for macro enabled sheets. I could not upload an xlsm file directly
as it is not a supported upload file type.the xls filetype is supported
It worked perfectly all day yesterday with these revisions and so all should be good.
BetAngel_1_AUTOCLEARS_STATUS_AT_MKT_CHANGE (V2.1).xls
You do not have the required permissions to view the files attached to this post.
Dr Ginhog
Posts: 260
Joined: Wed Nov 03, 2010 12:10 am
Location: Ballygarvan,Cork Ireland T12D2VR
Contact:

This the last change.While i corrected a macro problem in the previous upload I never corrected the sheet itself which had Headers and command option info removed also. Now we have the fully corrected working version. If anybody has any comments or criticisms about the
sheet I dont mind hearing from you. While its all been done before and done very well I would like to think this is a different fully automated (with manual control also) variation on a theme.
BetAngel_1_AUTOCLEARS_STATUS_AT_MKT_CHANGE_(V2.1).xls
You do not have the required permissions to view the files attached to this post.
bvdahl
Posts: 4
Joined: Tue Oct 13, 2020 7:55 am

Hello all,

I just created a routine that runs every minute and clears the status fields. It can also be triggered by a button I have in the sheet. I found that if I tried to tie this to cell changes, there were too many things happening at once, and the danger of double bets was very high. Running this task on a schedule (in the example, every minute, but it can be changed), leads to much fewer errors.

I am using it for Golf, which I guess is much less time-critical than most sports as the start approaches, but maybe you will find it useful anyway. I am pasting the specific code, and not the whole spreadsheet, but hopefully, it is clear.

One last note, you have to remember to run the 'StopTimer' procedure before closing the sheet, otherwise, it will mess with the state of excel. I have put it in the close event of the spreadsheet, in addition to having a button for it + a cell that turns green once the timer is running.

Cheers,
Baard

Code: Select all

Public RunWhen As Double
Public Const cRunWhat = "ScheduleClearUpdates"

Sub StartTimer()

Sheets("Settings").Range("L12").Interior.ColorIndex = 4



RunWhen = Now + TimeSerial(0, 1, 0)
Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, _
     schedule:=True
End Sub

Sub StopTimer()

Sheets("Settings").Range("L12").Interior.ColorIndex = 3

   On Error Resume Next
   Application.OnTime earliesttime:=RunWhen, _
       procedure:=cRunWhat, schedule:=False
End Sub

Sub ScheduleClearUpdates()
    Tour = "EUR"
    Call ClearStatuses
    Tour = "PGA"
    Call ClearStatuses
    Tour = ""
    Sheets("Settings").Range("L13") = Now
    Call StartTimer
End Sub


Sub ClearStatuses()

Dim BFNames() As String
Dim PlayerRow As Integer

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False


If TypeName(Application.Caller) = "String" Then

    Tour = Left(Application.Caller, 3)

End If

Call DefineSheets

ReDim BFSheets(1 To 4)

BFSheets(1) = tw.Name
BFSheets(2) = t5.Name
BFSheets(3) = t10.Name
BFSheets(4) = t20.Name

For i = 1 To UBound(BFSheets)

    LastRow = Sheets(BFSheets(i)).Cells(1000, 2).End(xlUp).Row
    
    Sheets(BFSheets(i)).Cells(6, 15) = ""
    
    For ii = 9 To LastRow Step 2
    
        If Sheets(BFSheets(i)).Cells(ii, 15) <> "" And Sheets(BFSheets(i)).Cells(ii, 15) <> "PLACING" Then
        
            Sheets(BFSheets(i)).Cells(ii, 15) = ""
        
        End If
    
        If Sheets(BFSheets(i)).Cells(ii + 1, 12) <> "" And Sheets(BFSheets(i)).Cells(ii, 15) <> "PLACING" Then
        
            Sheets(BFSheets(i)).Cells(ii + 1, 12) = ""
        
        End If
    
    Next ii
    

Next i



Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

Sub DefineSheets()

'Sets the variable for the current workbook

Set wb = ActiveWorkbook


'FilePath = Range("PlayerFile")
'Set gp = Workbooks("GolfPlayers.xlsx")


'Call FindNewestFile
'Setting the variables for each worksheet


Set s = wb.Sheets("Settings")
Set p = wb.Sheets("Players")

Set tw = wb.Sheets(Tour & " Winner")
Set t5 = wb.Sheets(Tour & " Top5")
Set t10 = wb.Sheets(Tour & " Top10")
Set t20 = wb.Sheets(Tour & " Top20")
Set tm = wb.Sheets(Tour & " MatchUps")
Set twb = wb.Sheets(Tour & " Winner Bets")
Set t5b = wb.Sheets(Tour & " Top5 Bets")
Set t10b = wb.Sheets(Tour & " Top10 Bets")
Set t20b = wb.Sheets(Tour & " Top20 Bets")
Set f = wb.Sheets(Tour & " Field")

End Sub
Post Reply

Return to “Bet Angel - Example spreadsheets”