100% Processor code

[spliffcity]

Guys,

Can anyone spot why this function and the ones below cause BA and excel to go into 100% processor utilisation?

No doubt i'm being daft. The function is designed to get the market id and start time. I then use the ba event to drive the selection of the markets throughout the day on auto pilot.

Code: Select all

Function Get_Race_ID(szCourseName, szRaceTime)

    Dim arrEvnt()
    ReDim Preserve arrEvnt(1)
   
    Set ba = New BettingAssistantCom.ComClass
       
    sports = ba.getSports()
    For Each s In sports
       If s.sport = "Horse Racing" Then
           events = ba.getEvents(s.sportId)
            For Each e In events
                If e.eventname = "GB" Then
                  GBEvents = ba.getEvents(e.eventId)
                    For Each GBEvent In GBEvents
                        arrCourse = Split(GBEvent.eventname, " ")
                        If InStr(Name_Check(szCourseName), arrCourse(0)) Then
                            If InStr(GBEvent.eventname, Get_Date) Then
                               races = ba.getEvents(GBEvent.eventId)
                                For Each race In races
                                    If InStr(race.startTime, szRaceTime) Then
                                        If Not race.eventname = "To Be Placed" Then
                                           
                                            arrEvnt(0) = race.eventId
                                            arrEvnt(1) = race.startTime
                                            Get_Race_ID = arrEvnt
                                           
                                            Set ba = Nothing
                                            Exit Function
                                           
                                        End If
                                    End If
                                Next
                            End If
                        End If
                    Next
                End If
            Next
        End If
    Next
   
   
End Function

   

Function Get_Date()
     Get_Date = Replace(Format(Date, "dd"), "0", "")
End Function

Function Name_Check(szCourseName)

    Select Case szCourseName
    Case "Great Leighs"
        Name_Check = "GLghs"
        Exit Function
    Case "Southwell"
        Name_Check = "Sthl"
        Exit Function
    End Select
       
       Name_Check = szCourseName

End Function

Cheers
Mark.

[spliffcity]

or does anyone have a better function to get the market ID etc.

I'm stumped here guys. Is it lazy coding by not declaring variables that is effecting it?

Please help.

Cheers
Mark.

[GaryRussell]

Your code causes BA to make the API calls to retrieve the markets every time. It is better to do it only when the workbook opens. The following code will load the markets when the workbook opens and retrieve the id from an array in memory whenever you call Get_Race_ID.
You can get all the abbreviations to insert in Name_Check from http://bdpsupport.betfair.com/ics/suppo ... leID=32225

Insert the following code into your module.

Code: Select all

Option Explicit

Private ba As New BettingAssistantCom.ComClass
Private course_names() As String
Private race_times() As String
Private event_id() As String

Public Function Get_Race_ID(szCourseName, szRaceTime) As String()
    Dim i As Integer
    Dim result(1) As String
    For i = 0 To UBound(course_names)
        If InStr(Name_Check(szCourseName), course_names(i)) <> 0 And InStr(race_times(i), szRaceTime) <> 0 Then
            result(0) = event_id(i)
            result(1) = race_times(i)
            Exit For
        End If
    Next
    Get_Race_ID = result
End Function

Public Sub get_race_ids()
    Dim r As Integer
    Dim sports() As Variant
    Dim events() As Variant
    Dim GBEvents() As Variant
    Dim races() As Variant
    Dim s As Variant
    Dim e As Variant
    Dim GBEvent As Variant
    Dim arrCourse() As String
    Dim race As Variant
    r = -1
    sports = ba.getSports()
    For Each s In sports
       If s.sport = "Horse Racing" Then
           events = ba.getEvents(s.sportId)
            For Each e In events
                If e.eventname = "GB" Then
                  GBEvents = ba.getEvents(e.eventId)
                    For Each GBEvent In GBEvents
                        arrCourse = Split(GBEvent.eventname, " ")
                        If InStr(GBEvent.eventname, Get_Date) Then
                           races = ba.getEvents(GBEvent.eventId)
                           For Each race In races
                               r = r + 1
                               If Not race.eventname = "To Be Placed" Then
                                   ReDim Preserve course_names(r)
                                   ReDim Preserve race_times(r)
                                   ReDim Preserve event_id(r)
                                   course_names(r) = arrCourse(0)
                                   race_times(r) = race.startTime
                                   event_id(r) = race.eventId
                               End If
                           Next
                        End If
                    Next
                End If
            Next
        End If
    Next
End Sub

Function Get_Date()
     Get_Date = Replace(Format(Date, "dd"), "0", "")
End Function

Function Name_Check(szCourseName)
    Select Case szCourseName
    Case "Great Leighs"
        Name_Check = "GLghs"
        Exit Function
    Case "Southwell"
        Name_Check = "Sthl"
        Exit Function
    Case "Lingfield"
        Name_Check = "Ling"
        Exit Function
    Case "Catterick"
        Name_Check = "Catt"
        Exit Function
    Case "Fontwell"
        Name_Check = "Font"
        Exit Function
    End Select
    Name_Check = szCourseName
End Function


Insert the following code into the ThisWorkbook

Code: Select all

Private Sub Workbook_Open()
    get_race_ids
End Sub

[spliffcity]

Gary,

Again, as always thanks so much for this.

I hadn't even given consideration to BA having to make API calls. I just assumed everything was cached locally.

I'll implement right away.

Cheers
Mark.