Pull data from an internet source about college football and place it in charts

[dnorris707]

the following program is supposed to pull data from an internet source about college football and place it in charts. the first program makes the charts then the next one organizes them. the way it works is by putting the first game of every season in, then going back and putting in the second and so on. I have gotten it to where it will input text in the correct areas, but im not sure how to make sure its putting the right data.

Dim team As String


Sub Auto()
'On Error Resume Next
'Dim team As String
Dim teamm As String
Dim yre As Integer
Dim lge As String
Dim Team1 As String
Dim date1 As String
Dim count As Integer
    count = 1
Dim Year As Integer
    Year = 2012
Dim cal As Date
Dim Opponent As String
Dim Location As String
Dim Result As String
'Set objie = CreateObject("InternetExplorer.Application")

team = InputBox("Team?")
If team = "" Then End

Cells.clear

Again:
        Worksheets("Sheet1").Cells(count, 3) = team & " " & Year
            Worksheets("Sheet1").Cells(count, 3).font.Bold = True
            Worksheets("Sheet1").Cells(count, 3).font.Size = 12
        Worksheets("Sheet1").Cells(count + 1, 1) = "Date"
             Worksheets("Sheet1").Cells(count + 1, 1).font.Bold = True
             Worksheets("Sheet1").Cells(count + 1, 1).font.Size = 12
        Worksheets("Sheet1").Cells(count + 1, 2) = "Opponent"
            Worksheets("Sheet1").Cells(count + 1, 2).font.Bold = True
            Worksheets("Sheet1").Cells(count + 1, 2).font.Size = 12
        Worksheets("Sheet1").Cells(count + 1, 3) = "Location"
             Worksheets("Sheet1").Cells(count + 1, 3).font.Bold = True
            Worksheets("Sheet1").Cells(count + 1, 3).font.Size = 12
        Worksheets("Sheet1").Cells(count + 1, 4) = "Result"
            Worksheets("Sheet1").Cells(count + 1, 4).font.Bold = True
            Worksheets("Sheet1").Cells(count + 1, 4).font.Size = 12
        Worksheets("Sheet1").Cells(count + 1, 5) = "Score"
            Worksheets("Sheet1").Cells(count + 1, 5).font.Bold = True
            Worksheets("Sheet1").Cells(count + 1, 5).font.Size = 12
        Year = Year - 1
        count = count + 18
        If Year = 1862 Then GoTo done
    GoTo Again
done:
MsgBox ("DONE WITH CHARTS")
Call Blah
        'MsgBox ("Done")
End Sub


Sub Blah()
On Error Resume Next
'Dim team As String
Dim teamm As String
Dim yre As Integer
Dim lge As String
Dim Team1 As String
Dim date1 As String
Dim outcome As String
Dim scorea As String
Dim scoreb As String
Dim score As String
'Dim Sep As Variant
'Dim Sep2 As Variant
Dim row As Integer
Dim pos As String
Dim chk As String
Dim loc As String
WB:
count = 0
row = 3
yre = 2012
nmbr = 0
Set objie = CreateObject("InternetExplorer.Application")
KB:
'team = InputBox("What Team?")
Again:
'yre = InputBox("What Year")
teamm = Replace(team, " ", "")
teamm = Replace(teamm, "amp;", "")
objie.navigate ("http://www.jhowell.net/cf/scores/" & teamm & ".htm")
    Do
        DoEvents
    Loop Until objie.readyState = READYSTATE_COMPLETE
    
search_point = objie.document.body.innerHTML
lge = Mid(search_point, InStr(search_point, yre & "-" & team))
    If lge = chk Then
        yre = yre - 1
        row = row + 18
        GoTo Again
    End If
chk = lge
Sep = Split(lge, "</td>")
'j:
'MsgBox (Sep(count))
'count = count + 1
'GoTo j
loc = ""
loc = (Trim((Replace((Mid(Sep(count + 7), InStr(Sep(count + 7), "@"))), "@", ""))))
Sep2 = Split(Sep(count + 3), "<")
pos = Trim(Mid(Sep(2), 23, 3))
'dont forget to sync year
date1 = Trim((Mid(Sep(count + 1), 47, 4))) & "/" & yre
outcome = Trim((Mid(Sep(count + 4), 23, 1)))
scorea = Trim((Mid(Sep(count + 5), 37, 3)))
scoreb = Trim((Mid(Sep(count + 6), 37, 3)))
score = (scorea & "-" & scoreb)
Team1 = Trim(Replace(Mid(Sep2(2), InStr(Sep2(2), ">")), ">", ""))
Team1 = Replace(Team1, "amp;", "")
Cells(row + nmbr, 1).Value = date1
Cells(row + nmbr, 2).Value = Team1
'determining location
        If (Len(loc)) <> 0 Then
            Cells(row + nmbr, 3).Value = loc
           'count = 7
            GoTo g
            End If
        If pos = "vs." Then Cells(row + nmbr, 3).Value = team
        If pos = "@" Then Cells(row + nmbr, 3).Value = Team1
g:
'count = 6
Cells(row + nmbr, 4).Value = outcome
Cells(row + nmbr, 5).Value = score
row = row + 18
yre = yre - 1
If yre < 1999 Then GoTo e
GoTo Again
'End
'A:
    'MsgBox ("They Didn't Play That Year")
    'GoTo Again
e:
row = 3
nmbr = nmbr + 1
count = count + 1
yre = 2012
MsgBox ("1st game complete")
GoTo KB
End Sub

[Ed_Collins]

Hi dnorris,

I can see you're really having some trouble with your project.

This macro might make it easier for you. At the click of a button, the workbook below will go to that jhowell website, and download all of the data for you.

You can then begin formatting it as you wish.

Each team will be listed on its own tab.

To avoid having a single workbook with almost 300 tabs in it, you will probably want to run it a few times, creating new workbooks with 20-30 tabs each, or something like that.

college football data for dnorris.xlsm

Enjoy.