OZmium Sports Betting and Horse Racing Forums - download unitab horse data into excel spreadsheet

OZmium Sports Betting and Horse Racing Forums (http://forums.ozmium.com.au/index.php)

- General Topics (http://forums.ozmium.com.au/forumdisplay.php?f=59)

- - download unitab horse data into excel spreadsheet - problem (http://forums.ozmium.com.au/showthread.php?t=20306)

Updated, still increasing file size, maybe to do with the fact it is xls. If you can save it as a xlsm file

the issue with the racelist is to do with lines 100-101 in the code. Cause im on a mac, you may need to play with it and trial and error

Code:


Sub GetRaces2()
    Sheets("RaceList").Select
    Sheets("RaceList").Range("A2:AB500").Select
    Selection.ClearContents
    Sheets("Races2").Select
    Sheets("Races2").Cells.Select
    Selection.ClearContents
    With Sheets("Races2").QueryTables.Add(Connection:= _
        "URL;http://formguide.cyberhorse.com.au/index.php/Form/view-form.html" _
        , Destination:=Sheets("Races2").Range("$A$1"))
        .Name = False
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .Refresh BackgroundQuery:=False
    End With
    A = 2
    B = 2
    strquote = Chr$(34)
    TrackName = vbNullString
    RaceNumber = 0
    Do While Sheets("Races2").Cells(A, 1) <> vbNullString Or Sheets("Races2").Cells(A + 1, 1) <> vbNullString
        If IsNumeric(Sheets("Races2").Cells(A, 1)) = False Then
            TrackName = Sheets("Races2").Cells(A, 1)
            If TrackName = "Port Macquarie" Then TrackName = "Pt Macquarie"
            A = A + 2
        End If
        If IsNumeric(Sheets("Races2").Cells(A, 1)) = True Then
            RaceNumber = Sheets("Races2").Cells(A, 1)
            Sheets("RaceList").Cells(B, 1) = TrackName
            Sheets("RaceList").Cells(B, 2) = RaceNumber
            Sheets("RaceList").Cells(B, 3) = "=GetAddress(Races2!E" & A & ")"
            Sheets("RaceList").Cells(B, 4) = "=SUBSTITUTE(C" & B & "," & strquote & "&" & strquote & "," & strquote & "&&" & strquote & ")"
            Sheets("RaceList").Cells(B, 4) = "http://" & "formguide.cyberhorse.com.au/index.php/Form/form.html?" & Right(Sheets("RaceList").Cells(B, 4), Len(Sheets("RaceList").Cells(B, 4)) - 80)
            Sheets("RaceList").Cells(B, 5) = "'" & Mid(Sheets("RaceList").Cells(B, 4), 70, 10)
            A = A + 1
            B = B + 1
        End If
    Loop
    RaceCount = B - 1
End Sub

My vba is limited but i can see where the problem is, in the above code if all we need is the address can't we just use what is outputted in column C

No, for some reason the address that comes out is incorrect. i have to put in an extra 2 lines of code for column D. the first one adds an extra ampersand as excel removes the ampersand from any webpages. The second line of code sets up the correct webpage. the incorrect address does provide the information to convert it to the correct address.

I will have a play with it when i get time, if i get it working i will create a ratings sheet that anyone can add there own figures to each form factor to make there own ratings.

I am having an issue, i am using part of your code but it keeps dropping race 1 from each venue when it creates the racelist, bit of help needed.

Code:



'Global RaceCodes(1 To 20) As String
'Global RaceNumbers(1 To 12) As Integer
Global RaceCount As Integer
Global RaceNo As Integer
Global RaceCode As String
Sub RunAll()
    Application.Calculation = xlCalculationAutomatic
    GetRaces2
        For RaceNo = 2 To 2 'RaceCount
        Next RaceNo
End Sub
Sub GetRaces2()
    Sheets("RaceList").Select
    Sheets("RaceList").Range("A2:AB500").Select
    Selection.ClearContents
    Sheets("Races2").Select
    Sheets("Races2").Cells.Select
    Selection.ClearContents
    With Sheets("Races2").QueryTables.Add(Connection:= _
        "URL;http://formguide.cyberhorse.com.au/index.php/Form/view-form.html" _
        , Destination:=Sheets("Races2").Range("$A$1"))
        .Name = False
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .Refresh BackgroundQuery:=False
    End With
    A = 2
    B = 2
    strquote = Chr$(34)
    TrackName = vbNullString
    RaceNumber = 0
    Do While Sheets("Races2").Cells(A, 1) <> vbNullString Or Sheets("Races2").Cells(A + 1, 1) <> vbNullString
        If IsNumeric(Sheets("Races2").Cells(A, 1)) = False Then
            TrackName = Sheets("Races2").Cells(A, 1)
            If TrackName = "Port Macquarie" Then TrackName = "Pt Macquarie"
            A = A + 2
        End If
        If IsNumeric(Sheets("Races2").Cells(A, 1)) = True Then
            RaceNumber = Sheets("Races2").Cells(A, 1)
            Sheets("RaceList").Cells(B, 1) = TrackName
            Sheets("RaceList").Cells(B, 2) = RaceNumber
            Sheets("RaceList").Cells(B, 3) = "=GetAddress(Races2!E" & A & ")"
            Sheets("RaceList").Cells(B, 4) = "=SUBSTITUTE(C" & B & "," & strquote & "&" & strquote & "," & strquote & "&&" & strquote & ")"
            Sheets("RaceList").Cells(B, 4) = "http://" & "formguide.cyberhorse.com.au/index.php/Form/form.html?" & Right(Sheets("RaceList").Cells(B, 4), Len(Sheets("RaceList").Cells(B, 4)) - 80)
            Sheets("RaceList").Cells(B, 5) = "'" & Mid(Sheets("RaceList").Cells(B, 4), 70, 10)
            A = A + 1
            B = B + 1
        End If
    Loop
    RaceCount = B - 1
End Sub

Function GetAddress(HyperlinkCell As Range)
    GetAddress = Replace _
    (HyperlinkCell.Hyperlinks(1).Address, "mailto:", "")
End Function

Using code provided by kennedy22384 i have put together a sheet that will download each race and output ratings, the value of each form figure can be changed on the "Tables" sheet just change the figures in red to suit your own ratings, if you wish to exclude a form criteria from your ratings just place an "X" in the box above that list to exclude.

You will need to remove all the days races that i have tested it on so delete all sheets after the "Data" sheet, there are still plenty of bugs and it crashes after a while and takes about 30 seconds a race to update so i still have work to do, or maybe others can solve the issues.

To start the sheet go to the "Data" sheet and hit "Start" If it does crash just hit Debug then close the VBA window and press "Re-Start" you may lose the info for that race but it should continue on.

I hope to have bugs fixed in a few days.

Cool Shaun, I have just been data mining for greyhound's names for the last 5 days or so, i will test when im done with that cause then i got to get the form for each dog and let me say, this will take a while.

I found a few bugs and am adding more ideas so that is just a rough draft

Fixed a few bugs and added the option to import single race one at a time.
I also added a delete button that will delete all the extra sheets that are created when the days racing is done.

Open the sheet go to data and press Start this imports the race lists, then you have the option to use Automatic to import all races or Manual for a single race.

For single race option just click on the first cell of the race you want on the left hand side then press Manual