most of that would be simple copy paste for history. you really dont need pearl vb can handle this simple stuff
key is to finding the sites in the correct format for mining
this is my macro for mining the humidity, and prob the most complex of all the ones i use
Sub Humidity()
Team_col = 128
Hum = 67
Sheets("Sheet2").Visible = True
Last_game = Worksheets("PDWS").Cells(26, 6).End(xlUp).Row
For i = 2 To Last_game
If Worksheets("PDWS").Cells(i, 1) = "Postponed" Then GoTo nextgame:
Sheets("Sheet2").Select
Cells.Select
Selection.ClearContents
Game_day = Format(Worksheets("PDWS").Cells(i, 4), "yyyy/mm/dd")
Game_time = Worksheets("PDWS").Cells(i, 5)
If Right(Game_time, 1) = "p" And Left(Game_time, 2) = 12 Then
Add_hours = 0
ElseIf Right(Game_time, 1) = "a" Then
Add_hours = 0
Else
Add_hours = 12
End If
If Len(Game_time) = 6 Then
Hours = CInt(Left(Game_time, 2)) + Add_hours
Minutes = CDbl(Mid(Game_time, 4, 2) / 60)
Game_time = Hours + Minutes
Else
Hours = CInt(Left(Game_time, 1)) + Add_hours
Minutes = CDbl(Mid(Game_time, 3, 2) / 60)
Game_time = Hours + Minutes
End If
Airport = Worksheets("PDWS").Cells(i, 124)
City = Worksheets("PDWS").Cells(i, 125)
State = Worksheets("PDWS").Cells(i, 126)
Full_State = Worksheets("PDWS").Cells(i, 127)
If Worksheets("PDWS").Cells(i, 9) = "TOR" Then
URL = "http://www.wunderground.com/history/airport/CYTZ/" & Game_day & "/DailyHistory.html?"
GoTo Toronto:
End If
URL = "http://www.wunderground.com/history/airport/" & Airport & "/" & Game_day & "/DailyHistory.html?req_city=" & City & "&req_state=" & State & "&req_statename=" & Full_State
Toronto:
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URL, Destination:=Range("A1"))
.Name = "weather"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
skipline:
Cells.Select
Selection.Find(What:="Hourly Observations", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
start_row = ActiveCell.Row + 3
Selection.Find(What:="Show full METARS METAR FAQ Comma Delimited File", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
End_row = ActiveCell.Row - 1
Selection.Find(What:="Humidity:", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Humidity_col = ActiveCell.Column
Selection.Find(What:="Time (", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Time_col = ActiveCell.Column
Time_zone = ActiveCell.Value
If InStr(Time_zone, "EDT") > 0 Then Game_time = Game_time + 3
If InStr(Time_zone, "MDT") > 0 Then Game_time = Game_time + 2
If InStr(Time_zone, "CDT") > 0 Then Game_time = Game_time + 2
Begin_row = start_row
'Begin_row = 80
For j = Begin_row To End_row
temp1 = Trim(Worksheets("Sheet2").Cells(j, Time_col)) * 24
temp2 = Game_time - temp1
If Game_time - temp1 < 0 And Game_time - temp1 > -1 Then
If Worksheets("PDWS").Cells(i, 10) = "I" Then
Worksheets("PDWS").Cells(i, Hum) = 50
GoTo nextgame:
Else
Worksheets("PDWS").Cells(i, Hum) = Worksheets("Sheet2").Cells(j, Humidity_col) * 100
GoTo nextgame:
End If
End If
Next j
nextgame:
' i = i + 3
Next i
Sheets("Sheet2").Visible = False
Sheets("PDWS").Select
End Sub
Sub Projected_Umps()
Proj_ump = 71
Last_game = Worksheets("PDWS").Cells(26, 6).End(xlUp).Row
Sheets("Sheet2").Select
Cells.Select
Selection.ClearContents
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.statfox.com/mlb/umpiremain.asp", Destination:=Range("$A$1"))
.Name = "weather"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Selection.Find(What:="Umpire", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Begin_row = ActiveCell.Row + 3
last_row = Range("L10000").End(xlUp).Row
start_row = Begin_row
For i = 2 To Last_game
Vis_team2 = Worksheets("PDWS").Cells(i, 132)
For j = start_row To last_row
Vis_team1 = Trim(Left(Worksheets("Sheet2").Cells(j, 1), 3))
If Vis_team1 = Vis_team2 Then
Worksheets("PDWS").Cells(i, Proj_ump) = Worksheets("Sheet2").Cells(j, 3)
start_row = j
GoTo nextline:
End If
Next j
nextline:
Next i
Sheets("PDWS").Select
End Sub
