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
Bookmarks