Private Sub Aut
pen()
Application.ScreenUpdating = False
'HTTP
Dim x
On Error Resume Next
x = Worksheets("HTTP").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "HTTP"
On Error GoTo 0
'DWN
Dim y
On Error Resume Next
y = Worksheets("DWN").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "DWN"
On Error GoTo 0
'DATA
Dim z
On Error Resume Next
z = Worksheets("DATA").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "DATA"
On Error GoTo 0
'EXTRA'S
Dim w
On Error Resume Next
w = Worksheets("EXTRA'S").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "EXTRA'S"
On Error GoTo 0
'SETTINGS
Dim v
On Error Resume Next
v = Worksheets("SETTINGS").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "SETTINGS"
On Error GoTo 0
'BOOKIE
Dim u
On Error Resume Next
u = Worksheets("BOOKIE").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "BOOKIE"
On Error GoTo 0
Application.Run "PREPARE_EXTRAS"
Application.Run "PREPARE_SETTINGS"
Application.Run "PREPARE_HTTP"
Application.Run "PREPARE_BOOKIE"
ThisWorkbook.Sheets("SETTINGS").Visible = False
Application.Run "TIDY_WORKBOOK"
Application.ScreenUpdating = True
End Sub
Sub SETUP()
'HTTP
Dim x
On Error Resume Next
x = Worksheets("HTTP").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "HTTP"
On Error GoTo 0
'DWN
Dim y
On Error Resume Next
y = Worksheets("DWN").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "DWN"
On Error GoTo 0
'DATA
Dim z
On Error Resume Next
z = Worksheets("DATA").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "DATA"
On Error GoTo 0
'EXTRA'S
Dim w
On Error Resume Next
w = Worksheets("EXTRA'S").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "EXTRA'S"
On Error GoTo 0
'SETTINGS
Dim v
On Error Resume Next
v = Worksheets("SETTINGS").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "SETTINGS"
On Error GoTo 0
'BOOKIE
Dim u
On Error Resume Next
u = Worksheets("BOOKIE").Name
If Not Err.Number = 0 Then Sheets.Add.Name = "BOOKIE"
On Error GoTo 0
Application.Run "PREPARE_EXTRAS"
Application.Run "PREPARE_SETTINGS"
Application.Run "PREPARE_HTTP"
Application.Run "PREPARE_BOOKIE"
ThisWorkbook.Sheets("SETTINGS").Visible = False
Application.Run "TIDY_WORKBOOK"
End Sub
Private Sub PREPARE_HTTP()
Sheets("HTTP").Activate
ActiveWorkbook.Names.Add Name:="HTTP", RefersToR1C1:="=HTTP!R1C1"
ActiveWorkbook.Names.Add Name:="HTTP_READ", RefersToR1C1:="=HTTP!R1C2"
Range("HTTP_READ").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'SCRAPE BUTTON
ActiveSheet.Buttons.Add(585.75, 0.75, 91.5, 27.75).Select
Selection.OnAction = "DOWNLOAD"
Selection.Characters.Text = "SCRAPE"
With Selection.Characters(START:=1, Length:=6).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
ActiveSheet.Shapes.Range(Array("Button 1")).Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Range("A1").Select
End Sub
Private Sub PREPARE_SETTINGS()
'
' Macro2 Macro
'
'
Sheets("SETTINGS").Activate
Range("A1").Select
ActiveWorkbook.Names.Add Name:="SETTINGS_1X2", RefersToR1C1:= _
"=SETTINGS!R1C1"
Range("A2").Select
ActiveWorkbook.Names.Add Name:="SETTINGS_OU", RefersToR1C1:= _
"=SETTINGS!R2C1"
Range("A3").Select
ActiveWorkbook.Names.Add Name:="SETTINGS_AH", RefersToR1C1:= _
"=SETTINGS!R3C1"
Range("A4").Select
ActiveWorkbook.Names.Add Name:="SETTINGS_DNB", RefersToR1C1:= _
"=SETTINGS!R4C1"
Range("A5").Select
ActiveWorkbook.Names.Add Name:="SETTINGS_DC", RefersToR1C1:= _
"=SETTINGS!R5C1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "§ion=uo-odds"
Range("A3").Select
ActiveCell.FormulaR1C1 = "§ion=ah-odds"
Range("A4").Select
ActiveCell.FormulaR1C1 = "§ion=ha-odds"
Range("A5").Select
ActiveCell.FormulaR1C1 = "§ion=dc-odds"
Range("A6").Select
End Sub
Private Sub PREPARE_BOOKIE()
'scrape button
Sheets("BOOKIE").Activate
Range("A1").Select
ActiveCell.FormulaR1C1 = "BOOKIE NAME"
Range("B1").Select
ActiveCell.FormulaR1C1 = "BOOKIE HTTP"
Range("A1:B1").Select
Selection.Font.Bold = True
Range("B1").Select
ActiveWorkbook.Names.Add Name:="BOOKIE_NAME", RefersToR1C1:= _
"='BOOKIE'!R2C1"
Range("B2").Select
ActiveWorkbook.Names.Add Name:="BOOKIE_HTTP", RefersToR1C1:= _
"='BOOKIE'!R2C2"
End Sub
Private Sub PREPARE_EXTRAS()
'
' Macro6 Macro
'
'
Sheets("EXTRA'S").Activate
Range("A1").Select
ActiveCell.FormulaR1C1 = "Match Time"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Playoff/Knockout"
Range("A3").Select
ActiveCell.FormulaR1C1 = "1x2"
Range("A4").Select
ActiveCell.FormulaR1C1 = "Over/Under"
Range("A5").Select
ActiveCell.FormulaR1C1 = "Asian Handicap"
Range("A6").Select
ActiveCell.FormulaR1C1 = "ODDs Days"
Range("B6").Select
ActiveCell.FormulaR1C1 = "3"
Sheets("EXTRA'S").Activate
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.End(xlUp).Select
Range(Selection, Selection.End(xlDown)).Select
Columns("A:A").Select
Selection.Font.Bold = True
Selection.End(xlUp).Select
Columns("B:B").ColumnWidth = 2.5
Columns("C:C").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireColumn.Hidden = True
Selection.End(xlToLeft).Select
Range("B1").Select
ActiveWorkbook.Names.Add Name:="EXTRAS_TIME", RefersToR1C1:= _
"='EXTRA''S'!R1C2"
Range("B2").Select
ActiveWorkbook.Names.Add Name:="EXTRAS_PO", RefersToR1C1:= _
"='EXTRA''S'!R2C2"
Range("B3").Select
ActiveWorkbook.Names.Add Name:="EXTRAS_1X2", RefersToR1C1:= _
"='EXTRA''S'!R3C2"
Range("B4").Select
ActiveWorkbook.Names.Add Name:="EXTRAS_OU", RefersToR1C1:= _
"='EXTRA''S'!R4C2"
Range("B5").Select
ActiveWorkbook.Names.Add Name:="EXTRAS_AH", RefersToR1C1:= _
"='EXTRA''S'!R5C2"
Range("B6").Select
ActiveWorkbook.Names.Add Name:="ODDS_DAYS", RefersToR1C1:= _
"='EXTRA''S'!R6C2"
End Sub
Private Sub HTTP_READER()
HTTP_0 = InStr(Range("HTTP").Value, "/?stage=")
If HTTP_0 = "0" Then HTTP_1 = Range("HTTP").Value Else HTTP_1 = Left(Range("HTTP").Value, HTTP_0)
D_FIX = InStr(HTTP_1, "/next/?")
D_RES = InStr(HTTP_1, "/results/?")
RES_0 = Right(HTTP_1, 9)
1 If D_FIX > 0 Then GoTo 2 Else GoTo 3
3 If D_RES > 0 Then GoTo 4 Else GoTo 5
5 If RES_0 = "/results/" Then GoTo 6 Else GoTo 8
Exit Sub
2
'date fixtures
Range("HTTP!B1").Value = "D_FIX"
GoTo 9
4
'date results
Range("HTTP!B1").Value = "D_RES"
GoTo 9
6
'results
Range("HTTP!B1").Value = "RES"
GoTo 9
8
'fixtures
Range("HTTP!B1").Value = "FIX"
9
End Sub
Private Sub TIDY_WORKBOOK()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "EXTRA'S" Or ws.Name = "DATA" Or ws.Name = "DWN" Or ws.Name = "HTTP" Or ws.Name = "BOOKIE" Then
ws.Visible = True
Else
ws.Visible = False
End If
Next ws
End Sub
Private Sub DWN()
'DOWNLOAD DATA
Application.Run "HTTP_READER"
If Range("EXTRAS_1X2").Value = "X" Or Range("EXTRAS_OU").Value = "X" Or Range("EXTRAS_AH").Value = "X" Then GoTo 2 Else GoTo 1
1
Sheets("DWN").Activate
URLVal1 = Range("HTTP").Value
Range("A:AZ").Select
Selection.Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URLVal1, Destination:=Range( _
"$A$1"))
.Name = "TEMP"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
'.WebTables = "1"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
Range("A1").Select
If Range("EXTRAS_PO").Value = "X" Then Application.Run "RESULTS_1_D1" Else Exit Sub
Exit Sub
2
Application.Run "DWN_FULL"
End Sub
Private Sub DWN_FULL()
'DOWNLOAD DATA
Sheets("DWN").Activate
URLVal1 = Range("HTTP").Value
Range("A:AZ").Select
Selection.Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URLVal1, Destination:=Range( _
"$A$1"))
.Name = "TEMP"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
'.WebTables = "1"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
If Range("EXTRAS_PO").Value = "X" Then Application.Run "RESULTS_1_D1" Else GoTo 2
2
Sheets("DWN").Activate
Columns("A:H").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
FinalRow = Range("A500000").End(xlUp).Row + 5
Range("A1").Select
Application.Run "HTTP_READER"
End Sub
Private Sub RES_1()
'
' RESULTS
'
'
Application.ScreenUpdating = False
Application.Run "DWN"
FinalRow = Range("A500000").End(xlUp).Row + 5
Dim HL As Hyperlink
For Each HL In ActiveSheet.Range("A10:A" & FinalRow).Hyperlinks
HL.Range.Offset(0, 2).Value = HL.Address
Next
'PREPARE DATA SHEET
Sheets("DATA").Activate
Cells.Clear
Range("A1:Z1").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("A1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "LEAGUE"
Range("C1").Select
ActiveCell.FormulaR1C1 = "FIXTURE"
Range("D1").Select
ActiveCell.FormulaR1C1 = "HOME"
Range("E1").Select
ActiveCell.FormulaR1C1 = "AWAY"
Range("F1").Select
ActiveCell.FormulaR1C1 = "SCORE"
Range("G1").Select
ActiveCell.FormulaR1C1 = "H"
Range("H1").Select
ActiveCell.FormulaR1C1 = "A"
Range("I1").Select
ActiveCell.FormulaR1C1 = "RESULT"
Range("J1").Select
ActiveCell.FormulaR1C1 = "HTTP"
Range("A1").Select
'INPUT FORMULAE
Sheets("DWN").Activate
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=IF(IFERROR(FIND(""» Soccer » "",RC[-7]),"""")<>"""",""[""&SUBSTITUTE(SUBSTITUTE(RC[-7],""» Soccer » "",""""),"" » "",""] ""),"""")"
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RC[-1],IF(R[-1]C<>"""",R[-1]C,""""))"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF(IFERROR(OR(FIND("". Round"",RC[-9]),"""")<>"""",(LEN(TRIM(RC[-4]))-LEN(SUBSTITUTE(TRIM(RC[-4]),""."","""")))/(LEN("".""))=2),1,"""")"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=1,1,IF(R[-1]C=1,1,""""))"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IF(IFERROR(FIND(""postp."",RC[-10]),"""")="""",IF(RC[-6]<>"""",IF(RC[-1]=1,SUBSTITUTE(SUBSTITUTE(RC[-6],""."",""/""),""."",""/"")*1,""""),""""),"""")"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-4],"""")"
Range("N2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]<>"""",SUBSTITUTE(RC[-13],"" - "","" vs. ""),"""")"
Range("O2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",LEFT(RC[-14],FIND("" - "",RC[-14])-1),"""")"
Range("P2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]<>"""",RIGHT(RC[-15],(LEN(RC[-15])-FIND("" - "",RC[-15]))-2),"""")"
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]<>"""",IF(RIGHT(RC[-15],2)=""OT"",RC[1]&"" - ""&RC[2]&"" (OT)"",RC[1]&"" - ""&RC[2]),"""")"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]<>"""",HOUR(SUBSTITUTE(SUBSTITUTE(RC[-16],""OT"",""""),"" awa."","""")),"""")"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]<>"""",MINUTE(SUBSTITUTE(SUBSTITUTE(RC[-17],""OT"",""""),"" awa."","""")),"""")"
Range("T2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",IF(RC[-2]>RC[-1],""H"",IF(RC[-1]>RC[-2],""A"",""D"")),"""")"
Range("U2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-9]<>"""",IF(RC[-18]<>"""",RC[-18],""""),"""")"
Range("H2:U2").Select
Selection.Copy
FinalRow = Range("A500000").End(xlUp).Row + 5
Range("H2:U" & FinalRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("L2:L" & FinalRow).Select
Selection.NumberFormat = "dd/mm/yy;@"
FinalRow = Range("A500000").End(xlUp).Row + 5
ActiveSheet.Range("$L$2:$U$" & FinalRow).AutoFilter Field:=1, Criteria1:="<>"
Range("$L$2:$U$" & FinalRow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
'COPY DATA TO DATASHEET
Sheets("DATA").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'SORT
FinalRow = Range("A500000").End(xlUp).Row
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("A2:A" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("B2:B" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("A1:J" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2:I" & FinalRow).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("DWN").Activate
Selection.AutoFilter
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("DATA").Activate
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
If Range("EXTRAS_1X2").Value = "X" Or Range("EXTRAS_OU").Value = "X" Or Range("EXTRAS_AH").Value = "X" Then GoTo 13 Else GoTo 10
10
'CLEAR
Sheets("DATA").Activate
If Range("EXTRAS_TIME").Value = "X" Then GoTo 11 Else GoTo 12
11
12
Range("J:J").Select
Selection.Clear
Range("A1").Select
13
Application.ScreenUpdating = True
End Sub
Private Sub FIX_1()
'
' FIXTURES
'
'
Application.ScreenUpdating = False
Application.Run "DWN"
FinalRow = Range("A500000").End(xlUp).Row + 5
Dim HL As Hyperlink
For Each HL In ActiveSheet.Range("B10:B" & FinalRow).Hyperlinks
HL.Range.Offset(0, 1).Value = HL.Address
Next
'PREPARE DATA SHEET
Sheets("DATA").Activate
Cells.Clear
Range("A1:H1").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
If Range("EXTRAS_TIME").Value = "X" Then GoTo 1 Else GoTo 2
'WITH TIMES
1
Range("A1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "TIME"
Range("C1").Select
ActiveCell.FormulaR1C1 = "LEAGUE"
Range("D1").Select
ActiveCell.FormulaR1C1 = "FIXTURE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "HOME"
Range("F1").Select
ActiveCell.FormulaR1C1 = "AWAY"
Range("G1").Select
ActiveCell.FormulaR1C1 = "HTTP"
GoTo 3
'WITH TIMES
2
Range("A1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "LEAGUE"
Range("C1").Select
ActiveCell.FormulaR1C1 = "FIXTURE"
Range("D1").Select
ActiveCell.FormulaR1C1 = "HOME"
Range("E1").Select
ActiveCell.FormulaR1C1 = "AWAY"
Range("F1").Select
ActiveCell.FormulaR1C1 = "HTTP"
Range("A1").Select
3
'INPUT FORMULAE
Sheets("DWN").Activate
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=IF(IFERROR(FIND(""» Soccer » "",RC[-9]),"""")<>"""",""[""&SUBSTITUTE(SUBSTITUTE(RC[-9],""» Soccer » "",""""),"" » "",""] ""),"""")"
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RC[-1],IF(R[-1]C<>"""",R[-1]C,""""))"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IF(AND(ROW()=2,IFERROR(FIND(""year"",HTTP),"""")<>""""),DATE(MID(HTTP,FIND(""year"",HTTP)+5,4)*1,SUBSTITUTE(SUBSTITUTE(MID(HTTP,FIND(""month"",HTTP)+5,3),""&"",""""),""="","""")*1,SUBSTITUTE(MID(HTTP,FIND(""day"",HTTP)+3,3),""="","""")*1),IF(IFERROR(FIND("" - "",RC[-10]),"""")<>"""",1,""""))"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=IF(IFERROR(FIND(""year"",HTTP),"""")<>"""",R2C12,IFERROR(SUBSTITUTE(LEFT(RC[-12],10),""."",""/"")*1,""""))"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=IF(R2C12<>"""",IFERROR(IF(LEN(HOUR(RC[-13]))=1,""0""&HOUR(RC[-13]),HOUR(RC[-13]))&"":""&IF(LEN(MINUTE(RC[-13]))=1,""0""&MINUTE(RC[-13]),MINUTE(RC[-13])),RC[-13]),IF(RC[-1]<>"""",RIGHT(RC[-13],5)*1,R[-1]C))"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",R[-1]C,RC[-2])"
Range("P2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-1]<>0,RC[-1]<>"""",RC[-4]=1),RC[-1],"""")"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=IF(R2C12<>"""",IF(AND(RC[-2]<>"""",TYPE(R[-1]C[-3])<>1),R[-1]C[-3],R[-1]C),IF(RC[-1]<>"""",RC[-6],""""))"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(R2C12<>"""",IF(IFERROR(FIND("": "",RC[-1]),"""")<>"""",RC[-1],R[-1]C),IF(IFERROR(FIND("":"",RC[-16]),"""")="""",IF(RC[-3]<>"""",SUBSTITUTE(RC[-16],"" - "","" vs. ""),""""),""""))"
Range("S2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",LEFT(RC[-17],FIND("" - "",RC[-17])-1),"""")"
Range("T2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RIGHT(RC[-18],LEN(RC[-18])-(FIND("" - "",RC[-18])+2)),"""")"
Range("U2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-18],"""")"
Range("V2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]<>"""",RC[-6],"""")"
Range("W2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-9],"""")"
Range("X2").Select
ActiveCell.FormulaR1C1 = "=IF(R2C12<>"""",IF(RC[-1]<>"""",RC[-6],""""),IF(RC[-1]<>"""",RC[-7],""""))"
Range("Y2").Select
ActiveCell.FormulaR1C1 = "=IF(R2C12<>"""",IF(RC[-1]<>"""",RC[-6]&"" vs. ""&RC[-5],""""),IF(RC[-2]<>"""",RC[-7],""""))"
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-7],"""")"
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-7],"""")"
Range("AB2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-7],"""")"
Range("J2:AB2").Select
Selection.Copy
FinalRow = Range("A500000").End(xlUp).Row + 5
Range("J2:AB" & FinalRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("P2:P" & FinalRow).Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("V2:V" & FinalRow).Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("W2:W" & FinalRow).Select
Selection.NumberFormat = "HH:MM"
FinalRow = Range("A500000").End(xlUp).Row + 5
If Range("EXTRAS_TIME").Value <> "X" Then GoTo 4 Else GoTo 5
4
ActiveSheet.Range("$P$2:$U$" & FinalRow).AutoFilter Field:=1, Criteria1:="<>"
Range("$P$2:$U$" & FinalRow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
GoTo 6
5
ActiveSheet.Range("$V$2:$AB$" & FinalRow).AutoFilter Field:=1, Criteria1:="<>"
Range("$V$2:$AB$" & FinalRow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
'COPY DATA TO DATASHEET
6
Sheets("DATA").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'SORT
FinalRow = Range("A500000").End(xlUp).Row
If Range("EXTRAS_TIME").Value <> "X" Then GoTo 7 Else GoTo 8
7 ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("A2:A" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("B2:B" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("A1:F" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
8 ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("A2:A" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("B2:B" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("C2:C" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("A1:G" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2:G" & FinalRow).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("DWN").Activate
Selection.AutoFilter
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("DATA").Activate
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
If Range("EXTRAS_1X2").Value = "X" Or Range("EXTRAS_OU").Value = "X" Or Range("EXTRAS_AH").Value = "X" Then GoTo 13 Else GoTo 10
10
'CLEAR G
Sheets("DATA").Activate
If Range("EXTRAS_TIME").Value = "X" Then GoTo 11 Else GoTo 12
11
Range("G:G").Select
Selection.Clear
Range("A1").Select
GoTo 13
12
Range("F:F").Select
Selection.Clear
Range("A1").Select
13
Application.ScreenUpdating = True
End Sub
Private Sub D_FIX1()
'
' FIXTURES
'
'
Application.ScreenUpdating = False
Application.Run "DWN"
FinalRow = Range("A500000").End(xlUp).Row + 5
Dim HL As Hyperlink
For Each HL In ActiveSheet.Range("B10:B" & FinalRow).Hyperlinks
HL.Range.Offset(0, 1).Value = HL.Address
Next
'PREPARE DATA SHEET
Sheets("DATA").Activate
Cells.Clear
Range("A1:Z1").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
If Range("EXTRAS_TIME").Value = "X" Then GoTo 1 Else GoTo 2
'WITH TIMES
1
Range("A1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "TIME"
Range("C1").Select
ActiveCell.FormulaR1C1 = "LEAGUE"
Range("D1").Select
ActiveCell.FormulaR1C1 = "FIXTURE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "HOME"
Range("F1").Select
ActiveCell.FormulaR1C1 = "AWAY"
Range("G1").Select
ActiveCell.FormulaR1C1 = "HTTP"
GoTo 3
'WITH TIMES
2
Range("A1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "LEAGUE"
Range("C1").Select
ActiveCell.FormulaR1C1 = "FIXTURE"
Range("D1").Select
ActiveCell.FormulaR1C1 = "HOME"
Range("E1").Select
ActiveCell.FormulaR1C1 = "AWAY"
Range("F1").Select
ActiveCell.FormulaR1C1 = "HTTP"
Range("A1").Select
3
'INPUT FORMULAE
Sheets("DWN").Activate
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(LEFT(RC[-8],8)=""next day"",AND(LEN(RC[-8])=10,TYPE(SUBSTITUTE(RC[-8],""."",""/"")*1)=1)),SUBSTITUTE(RIGHT(RC[-8],10),""."",""/"")*1,"""")"
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RC[-1],IF(R[-1]C<>"""",R[-1]C,""""))"
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RC[-1],IF(R[-1]C<>"""",R[-1]C,""""))"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(IFERROR(FIND("":"",RC[-11]),0)<>0,RC[-11],IF(R[-1]C<>"""",R[-1]C,""""))"
Range("M2").Select
ActiveCell.FormulaR1C1 = _
"=IF(IFERROR(FIND("" - "",RC[-11]),"""")<>"""",1,"""")"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-3],"""")"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-14],"""")"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",R[-1]C,RC[-2])"
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-1]<>0,RC[-1]<>"""",RC[-4]=1),RC[-1],"""")"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-6],"""")"
Range("S2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",IF(IFERROR(FIND("":"",RC[-17]),"""")="""",IF(RC[-3]<>"""",SUBSTITUTE(RC[-17],"" - "","" vs. ""),""""),""""),"""")"
Range("T2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",LEFT(RC[-18],FIND("" - "",RC[-18])-1),"""")"
Range("U2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RIGHT(RC[-19],LEN(RC[-19])-(FIND("" - "",RC[-19])+2)),"""")"
Range("V2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-19],"""")"
Range("W2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]<>"""",RC[-6],"""")"
Range("X2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-9],"""")"
Range("Y2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-7],"""")"
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]<>"""",RC[-7],"""")"
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-7],"""")"
Range("AB2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-7],"""")"
Range("AC2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-7]<>"""",RC[-7],"""")"
Range("I2:AC2").Select
Selection.Copy
FinalRow = Range("A500000").End(xlUp).Row + 5
Range("I2:AC" & FinalRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("Q2:Q" & FinalRow).Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("W2:W" & FinalRow).Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("X2:X" & FinalRow).Select
Selection.NumberFormat = "HH:MM"
FinalRow = Range("A500000").End(xlUp).Row + 5
If Range("EXTRAS_TIME").Value <> "X" Then GoTo 4 Else GoTo 5
4
ActiveSheet.Range("$Q$2:$V$" & FinalRow).AutoFilter Field:=1, Criteria1:="<>"
Range("$Q$2:$V$" & FinalRow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
GoTo 6
5
ActiveSheet.Range("$W$2:$AC$" & FinalRow).AutoFilter Field:=1, Criteria1:="<>"
Range("$W$2:$AC$" & FinalRow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
'COPY DATA TO DATASHEET
6
Sheets("DATA").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'SORT
FinalRow = Range("A500000").End(xlUp).Row
If Range("EXTRAS_TIME").Value <> "X" Then GoTo 7 Else GoTo 8
7 ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("A2:A" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("B2:B" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("A1:F" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
8 ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("A2:A" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("B2:B" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("C2:C" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("A1:G" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2:G" & FinalRow).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("DWN").Activate
Selection.AutoFilter
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("DATA").Activate
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
If Range("EXTRAS_1X2").Value = "X" Or Range("EXTRAS_OU").Value = "X" Or Range("EXTRAS_AH").Value = "X" Then GoTo 13 Else GoTo 10
10
'CLEAR G
Sheets("DATA").Activate
If Range("EXTRAS_TIME").Value = "X" Then GoTo 11 Else GoTo 12
11
Range("G:G").Select
Selection.Clear
Range("A1").Select
12
Range("F:F").Select
Selection.Clear
Range("A1").Select
13
Application.ScreenUpdating = True
End Sub
Private Sub D_RES1()
'
' FIXTURES
'
'
Application.ScreenUpdating = False
Application.Run "DWN"
FinalRow = Range("A500000").End(xlUp).Row + 5
Dim HL As Hyperlink
For Each HL In ActiveSheet.Range("B10:B" & FinalRow).Hyperlinks
HL.Range.Offset(0, 3).Value = HL.Address
Next
'PREPARE DATA SHEET
Sheets("DATA").Activate
Cells.Clear
Range("A1:Z1").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
If Range("EXTRAS_TIME").Value = "X" Then GoTo 1 Else GoTo 2
'WITH TIMES
1
Range("A1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "TIME"
Range("C1").Select
ActiveCell.FormulaR1C1 = "LEAGUE"
Range("D1").Select
ActiveCell.FormulaR1C1 = "FIXTURE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "HOME"
Range("F1").Select
ActiveCell.FormulaR1C1 = "AWAY"
Range("G1").Select
ActiveCell.FormulaR1C1 = "SCORE"
Range("H1").Select
ActiveCell.FormulaR1C1 = "H"
Range("I1").Select
ActiveCell.FormulaR1C1 = "A"
Range("J1").Select
ActiveCell.FormulaR1C1 = "RESULT"
Range("K1").Select
ActiveCell.FormulaR1C1 = "HTTP"
GoTo 3
'WITHOUT TIMES
2
Range("A1").Select
ActiveCell.FormulaR1C1 = "DATE"
Range("B1").Select
ActiveCell.FormulaR1C1 = "LEAGUE"
Range("C1").Select
ActiveCell.FormulaR1C1 = "FIXTURE"
Range("D1").Select
ActiveCell.FormulaR1C1 = "HOME"
Range("E1").Select
ActiveCell.FormulaR1C1 = "AWAY"
Range("F1").Select
ActiveCell.FormulaR1C1 = "SCORE"
Range("G1").Select
ActiveCell.FormulaR1C1 = "H"
Range("H1").Select
ActiveCell.FormulaR1C1 = "A"
Range("I1").Select
ActiveCell.FormulaR1C1 = "RESULT"
Range("J1").Select
ActiveCell.FormulaR1C1 = "HTTP"
Range("A1").Select
3
'INPUT FORMULAE
Sheets("DWN").Activate
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(LEFT(RC[-8],8)=""next day"",AND(LEN(RC[-8])=10,TYPE(SUBSTITUTE(RC[-8],""."",""/"")*1)=1)),SUBSTITUTE(RIGHT(RC[-8],10),""."",""/"")*1,"""")"
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RC[-1],IF(R[-1]C<>"""",R[-1]C,""""))"
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RC[-1],IF(R[-1]C<>"""",R[-1]C,""""))"
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IF(IFERROR(FIND("":"",RC[-11]),0)<>0,RC[-11],IF(R[-1]C<>"""",R[-1]C,""""))"
Range("M2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-10]<>""can."",IF(IFERROR(FIND("" - "",RC[-11]),"""")<>"""",1,""""),"""")"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-3],"""")"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-14],"""")"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",R[-1]C,RC[-2])"
Range("Q2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-1]<>0,RC[-1]<>"""",RC[-4]=1),RC[-1],"""")"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-6],"""")"
Range("S2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",IF(IFERROR(FIND("":"",RC[-17]),"""")="""",IF(RC[-3]<>"""",SUBSTITUTE(RC[-17],"" - "","" vs. ""),""""),""""),"""")"
Range("T2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",LEFT(RC[-18],FIND("" - "",RC[-18])-1),"""")"
Range("U2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",RIGHT(RC[-19],LEN(RC[-19])-(FIND("" - "",RC[-19])+2)),"""")"
Range("V2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[1]&"" - ""&RC[2],"""")"
Range("W2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]<>"""",IF(IFERROR(FIND("" "",RC[-20]),"""")="""",HOUR(RC[-20])*1,LEFT(RC[-20],FIND("":"",RC[-20])-1)*1),"""")"
Range("X2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",IF(IFERROR(FIND("" "",RC[-21]),"""")="""",MINUTE(RC[-21])*1,SUBSTITUTE(LEFT(RC[-21],FIND("" "",RC[-21])),RC[-1]&"":"","""")*1),"""")"
Range("Y2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",IF(RC[-2]>RC[-1],""H"",IF(RC[-1]>RC[-2],""A"",""D"")),"""")"
Range("Z2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",IF(RC[-21]<>"""",RC[-21],""""),"""")"
Range("AA2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-10]<>"""",RC[-10],"""")"
Range("AB2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-13],"""")"
Range("AC2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-11],"""")"
Range("AD2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]<>"""",RC[-11],"""")"
Range("AE2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-11],"""")"
Range("AF2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-11],"""")"
Range("AG2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-11],"""")"
Range("AH2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-11],"""")"
Range("AI2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-11],"""")"
Range("AJ2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",IF(RC[-2]>RC[-1],""H"",IF(RC[-1]>RC[-2],""A"",""D"")),"""")"
Range("AK2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]<>"""",IF(RC[-32]<>"""",RC[-32],""""),"""")"
Range("AJ3").Select
Range("I2:AK2").Select
Selection.Copy
FinalRow = Range("A500000").End(xlUp).Row + 5
Range("I2:AK" & FinalRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("Q2:Q" & FinalRow).Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("AA2:AA" & FinalRow).Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("AB2:AB" & FinalRow).Select
Selection.NumberFormat = "HH:MM"
FinalRow = Range("A500000").End(xlUp).Row + 5
If Range("EXTRAS_TIME").Value <> "X" Then GoTo 4 Else GoTo 5
4
ActiveSheet.Range("$Q$2:$Z$" & FinalRow).AutoFilter Field:=1, Criteria1:="<>"
Range("$Q$2:$Z$" & FinalRow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
GoTo 6
5
ActiveSheet.Range("$AA$2:$AK$" & FinalRow).AutoFilter Field:=1, Criteria1:="<>"
Range("$AA$2:$AK$" & FinalRow).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
'COPY DATA TO DATASHEET
6
Sheets("DATA").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'SORT
FinalRow = Range("A500000").End(xlUp).Row
If Range("EXTRAS_TIME").Value <> "X" Then GoTo 7 Else GoTo 8
7 ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("A2:A" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("B2:B" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("A1:J" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
8 ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("A2:A" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("B2:B" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("C2:C" & FinalRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATA").Sort
.SetRange Range("A1:K" & FinalRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2:J" & FinalRow).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("DWN").Activate
Selection.AutoFilter
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("DATA").Activate
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
If Range("EXTRAS_1X2").Value = "X" Or Range("EXTRAS_OU").Value = "X" Or Range("EXTRAS_AH").Value = "X" Then GoTo 13 Else GoTo 10
10
'CLEAR G
Sheets("DATA").Activate
If Range("EXTRAS_TIME").Value = "X" Then GoTo 11 Else GoTo 12
11
Range("K:K").Select
Selection.Clear
Range("A1").Select
GoTo 13
12
Range("J:J").Select
Selection.Clear
Range("A1").Select
13
Application.ScreenUpdating = True
End Sub
Sub DOWNLOAD()
Application.Run "HTTP_READER"
If Range("HTTP").Value <> "" Then GoTo 1 Else GoTo 2
1
If Range("HTTP_READ").Value = "RES" Then Application.Run "RES_1"
If Range("HTTP_READ").Value = "FIX" Then Application.Run "FIX_1"
If Range("HTTP_READ").Value = "D_RES" Then Application.Run "D_RES1"
If Range("HTTP_READ").Value = "D_FIX" Then Application.Run "D_FIX1"
Application.Run "ODDS"
Exit Sub
2
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
' Promt
strPrompt = "You'll Need To Type In A BetExplorer HTTP Address If You're Expecting To Scrape Some Data (the HTTP address needs to be typed into cell A1 in the HTTP sheet)"
' Dialog's Title
strTitle = "Need A HTTP!"
'Display MessageBox
iRet = MsgBox(strPrompt, vbOKOnly, strTitle)
End Sub
Private Sub RESULTS_1_D1()
If Range("EXTRAS_PO").Value = "X" Then GoTo 2 Else GoTo 3
2
START:
Sheets("HTTP").Activate
Range("C1").Select
Selection.ClearContents
Dim i As Integer
Dim sURL As String, T As String, sAllPosts As String
Dim oHttp As Object
Dim lTopicstart As Long, lTopicend As Long
Dim blWSExists As Boolean
'URL to open
sURL = Range("HTTP").Value
' Create an ServerXMLHTTP object and add some error trapping
On Error Resume Next
Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.ServerXMLHTTPRequest")
MsgBox "Error 0 has occured while creating a MSXML.ServerXMLHTTPRequest object"
End If
On Error GoTo 0
If oHttp Is Nothing Then
MsgBox "For some reason I wasn't able to make a MSXML2.ServerXMLHTTP object"
Exit Sub
End If
'Open the URL in browser object
On Error GoTo START:
oHttp.Open "GET", sURL, False
oHttp.Send
T = oHttp.responseText
SC_ST = "stages-menu"
SC_ED = "smActiveGroup"
'Extract the desired information from the returned HTML code (text)
'To make things a little easier I usually cut of most of the unwanted code first
'so sHTML is smaller to work with.
lTopicstart = InStr(1, T, SC_ST, vbTextCompare)
lTopicend = InStr(1, T, SC_ED, vbTextCompare)
'Now extract all text within the hyperlinks <a href..>..</a>
'because they represent the topics
On Error GoTo 1
i = 1
lTopicstart = 1
lTopicend = 1
Do While lTopicstart <> 0
i = i + 1
lTopicstart = InStr(lTopicend, T, SC_ST, vbTextCompare)
If lTopicstart <> 0 Then
lTopicstart = InStr(lTopicstart, T, SC_ST, vbTextCompare) + 1
lTopicend = InStr(lTopicstart, T, SC_ED, vbTextCompare)
T = Left(Mid(T, lTopicstart, lTopicend - lTopicstart), Len(Mid(T, lTopicstart, lTopicend - lTopicstart)) - 1)
sAllPosts = sAllPosts & Chr(13) & Mid(T, lTopicstart, lTopicend - lTopicstart)
End If
Loop
1
Range("C2").Value = T
T = (Len(T) - Len(Replace(T, "href", ""))) / Len("href")
If Left(Range("HTTP!C2").Value, 3) = "<!D" Then GoTo 3 Else Range("C1").Value = T
'Clean up
Set oHttp = Nothing
Range("C1:C2").WrapText = False
Application.Calculate
Range("C3").Select
ActiveCell.FormulaR1C1 = _
"=IF(ROW()-2<=R1C3,IFERROR(LEFT(HTTP,FIND(""?"",HTTP)-1),HTTP)&MID(R2C3,FIND(CHAR(127),SUBSTITUTE(R2C3,""?st"",CHAR(127),ROW()-2)),(FIND("">"",R2C3,FIND(CHAR(127),SUBSTITUTE(R2C3,""?st"",CHAR(127),ROW()-2)))-1)-(FIND(CHAR(127),SUBSTITUTE(R2C3,""?st"",CHAR(127),ROW()-2)))),"""")"
Range("C3").Select
Selection.Copy
Range("C3:C10").Select
ActiveSheet.Paste
Range("A1").Select
Application.Calculate
Range("C3:C10").Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C1:C10").Select
Selection.Clear
Range("A1").Select
Application.Run "DWN_STAGES"
Exit Sub
3
Range("C1:C3").Select
Selection.Clear
Range("A1").Select
End Sub
Private Sub DWN_STAGES()
'DOWNLOAD DATA
Sheets("DWN").Activate
Range("A:A").Select
Selection.Clear
URLVal1 = Range("HTTP").Value
URLVal2 = Range("HTTP!A2").Value
URLVal3 = Range("HTTP!A3").Value
URLVal4 = Range("HTTP!A4").Value
URLVal5 = Range("HTTP!A5").Value
Range("A:AZ").Select
Selection.Clear
'scrape1
1
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URLVal1, Destination:=Range( _
"$A$1"))
.Name = "TEMP"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
'.WebTables = "1"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
'scrape2
2
If URLVal2 <> "" Then GoTo 3 Else GoTo 10
3
FinalRow0 = Range("A500000").End(xlUp).Row + 5
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URLVal2, Destination:=Range( _
"$A$" & FinalRow0))
.Name = "TEMP"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
'.WebTables = "1"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
'scrape3
4
If URLVal3 <> "" Then GoTo 5 Else GoTo 10
5
FinalRow0 = Range("A500000").End(xlUp).Row + 5
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URLVal3, Destination:=Range( _
"$A$" & FinalRow0))
.Name = "TEMP"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
'.WebTables = "1"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
'scrape4
6
If URLVal4 <> "" Then GoTo 7 Else GoTo 10
7
FinalRow0 = Range("A500000").End(xlUp).Row + 5
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URLVal4, Destination:=Range( _
"$A$" & FinalRow0))
.Name = "TEMP"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
'.WebTables = "1"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
'scrape5
8
If URLVal5 <> "" Then GoTo 9 Else GoTo 10
9
FinalRow0 = Range("A500000").End(xlUp).Row + 5
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URLVal5, Destination:=Range( _
"$A$" & FinalRow0))
.Name = "TEMP"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
'.WebTables = "1"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
'tidy data
10
Columns("A:H").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.UnMerge
FinalRow = Range("A500000").End(xlUp).Row + 5
Range("A1").Select
Application.Run "HTTP_READER"
End Sub
Private Sub ODDS_PREP()
Application.ScreenUpdating = False
'matches
Sheets("DATA").Activate
FinalRow = Range("A500000").End(xlUp).Row + 5
Sheets("DWN").Activate
Range("A1").Select
ActiveCell.FormulaR1C1 = "=IF(DATA!RC[4]=""HTTP"",""E"",IF(DATA!RC[5]=""HTTP"",""F"",IF(DATA!RC[6]=""HTTP"",""G"",IF(DATA!RC[7]=""HTTP"",""H"",IF(DATA!RC[8]=""HTTP"",""I"",IF(DATA!RC[9]=""HTTP"",""J"",IF(DATA!RC[10]=""HTTP"",""K"")))))))"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=IF(DATA!RC=""LEAGUE"",""B"",IF(DATA!RC[1]=""LEAGUE"",""C"",IF(DATA!RC[2]=""LEAGUE"",""D"",IF(DATA!RC[3]=""LEAGUE"",""E""))))"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=IF(DATA!RC[-1]=""FIXTURE"",""B"",IF(DATA!RC=""FIXTURE"",""C"",IF(DATA!RC[1]=""FIXTURE"",""D"",IF(DATA!RC[2]=""FIXTURE"",""E"",IF(DATA!RC[3]=""FIXTURE"",""F"")))))"
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(INDIRECT(""DATA!""&R1C1&ROW())<>"""",INDIRECT(""DATA!""&R1C1&ROW()),"""")"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<>"""",INDIRECT(""DATA!""&R1C2&ROW())&"" - ""&INDIRECT(""DATA!""&R1C3&ROW()),"""")"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]<>"""",IF(AND(RC[-1]="""",DATA!RC[-3]-ODDS_DAYS<=TODAY()),ROW(),""""),"""")"
Range("A2:D2").Select
Selection.Copy
Range("A2:D" & FinalRow).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("E1").Select
ActiveCell.FormulaR1C1 = "=IF(DATA!RC=""HTTP"",""F"",IF(DATA!RC[1]=""HTTP"",""G"",IF(DATA!RC[2]=""HTTP"",""H"",IF(DATA!RC[3]=""HTTP"",""I"",IF(DATA!RC[4]=""HTTP"",""J"",IF(DATA!RC[5]=""HTTP"",""K"",IF(DATA!RC[6]=""HTTP"",""L"")))))))"
Range("A1").Select
'odds info
Range("D1").Select
ActiveCell.FormulaR1C1 = "#"
Range("E2").Select
ActiveCell.FormulaR1C1 = "COUNT"
Range("E3").Select
ActiveCell.FormulaR1C1 = "MAX"
Range("E4").Select
ActiveCell.FormulaR1C1 = "MIN"
Range("E6").Select
ActiveCell.FormulaR1C1 = "HTTP"
Range("E7").Select
ActiveCell.FormulaR1C1 = "STATUS"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=COUNT(C[-2])"
Range("F3").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-2])"
Range("F4").Select
ActiveCell.FormulaR1C1 = "=MIN(C[-2])"
Range("F6").Select
ActiveCell.FormulaR1C1 = "=INDIRECT(""A""&R[-2]C)"
Range("F7").Select
ActiveCell.FormulaR1C1 = _
"=""ODDS SCRAPING: ""&INDIRECT(""B""&R[-3]C)&"" (""&R[-5]C&"" remaining)"""
Range("F8").Select
' REGION
Range("E8").Select
ActiveCell.FormulaR1C1 = "REGION"
Range("F8").Select
ActiveCell.FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(R[16]C,""0"",""""),""5"","""")"
Range("E9").Select
ActiveCell.FormulaR1C1 = "B_1A"
Range("E10").Select
ActiveCell.FormulaR1C1 = "B_1B"
Range("E12").Select
ActiveCell.FormulaR1C1 = "1X2"
Range("E13").Select
ActiveCell.FormulaR1C1 = "OU"
Range("E14").Select
ActiveCell.FormulaR1C1 = "AH"
Range("AZ10").Select
ActiveCell.FormulaR1C1 = "=IF(AND(RC[-14]<>"""",RC[-13]<>"""",RC[-12]<>""""),MAX(RC[-13]/SUM(RC[-13]:RC[-12]),1-(RC[-13]/SUM(RC[-13]:RC[-12])))-MIN(RC[-13]/SUM(RC[-13]:RC[-12]),1-(RC[-13]/SUM(RC[-13]:RC[-12]))),"""")"
Range("AZ10").Select
Selection.Copy
Range("AZ10:AZ300").Select
ActiveSheet.Paste
'ah determiner
Range("F20").Select
ActiveCell.FormulaR1C1 = "-1.5"
Range("F21").Select
ActiveCell.FormulaR1C1 = "-1"
Range("F22").Select
ActiveCell.FormulaR1C1 = "-0.5"
Range("F23").Select
ActiveCell.FormulaR1C1 = "0"
Range("F24").Select
ActiveCell.FormulaR1C1 = "0.5"
Range("F25").Select
ActiveCell.FormulaR1C1 = "'+1"
Range("F26").Select
ActiveCell.FormulaR1C1 = "1.5"
Range("F27").Select
ActiveCell.FormulaR1C1 = "0, 0.5"
Range("F28").Select
ActiveCell.FormulaR1C1 = "0, -0.5"
Range("F29").Select
ActiveCell.FormulaR1C1 = "0.5, 1"
Range("F30").Select
ActiveCell.FormulaR1C1 = "'-0.5, -1"
Range("F31").Select
ActiveCell.FormulaR1C1 = "1, 1.5"
Range("F32").Select
ActiveCell.FormulaR1C1 = "'-1, -1.5"
Range("F33").Select
ActiveCell.FormulaR1C1 = "'-1.5, -2"
'BOOKIE INFO
Range("F9").Select
ActiveCell.FormulaR1C1 = "="">""&BOOKIE_NAME&""<"""
Range("F10").Select
ActiveCell.FormulaR1C1 = "=""</span></td></tr>"""
Range("F13").Select
ActiveCell.FormulaR1C1 = "=R[-4]C&""/a> <span>(www)</span></th><td class=""""unsortable tv""""> </td><td class=""""doublepar"""">2.50<"""
Range("F14").Select
ActiveCell.FormulaR1C1 = "=R[-5]C&""/a> <span>(www)</span></th><td class=""""unsortable tv""""> </td><td class=""""doublepar"""">""&SUBSTITUTE(VLOOKUP(MAX(R[6]C[-1]:R[19]C[-1]),R[6]C[-1]:R[19]C,2,FALSE),"","",""."")&""<"""
'AH INFO
Range("E20").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[34],SUBSTITUTE(RC[1],R8C6,"".""))+COUNTIF(C[33],SUBSTITUTE(RC[1],R8C6,"".""))"
Range("E20").Select
Selection.Copy
Range("E20:E33").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'ODDS READING
Range("K2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R[3]C11:R[3]C13,""---"")=0,R[3]C,"""")"
Range("K3").Select
ActiveCell.FormulaR1C1 = "=FIND(""odd="",R[9]C[-4])+5"
Range("K4").Select
ActiveCell.FormulaR1C1 = "=FIND("""""""",R[8]C7,R[-1]C)"
Range("K5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MID(R[7]C7,R[-2]C,R[-1]C-R[-2]C)*1,""---"")"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R[3]C11:R[3]C13,""---"")=0,R[3]C,"""")"
Range("L3").Select
ActiveCell.FormulaR1C1 = "=FIND(""odd="",R[9]C7,FIND(""odd="",R[9]C7)+5)+5"
Range("L4").Select
ActiveCell.FormulaR1C1 = "=FIND("""""""",R[8]C7,R[-1]C)"
Range("L5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MID(R[7]C7,R[-2]C,R[-1]C-R[-2]C)*1,""---"")"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R[3]C11:R[3]C13,""---"")=0,R[3]C,"""")"
Range("M3").Select
ActiveCell.FormulaR1C1 = _
"=FIND(""odd="",R[9]C7,FIND(""odd="",R[9]C7,FIND(""odd="",R[9]C7)+5)+5)+5"
Range("M4").Select
ActiveCell.FormulaR1C1 = "=FIND("""""""",R[8]C7,R[-1]C)"
Range("M5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MID(R[7]C7,R[-2]C,R[-1]C-R[-2]C)*1,""---"")"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R[3]C14:R[3]C15,""---"")=0,R[3]C,"""")"
Range("N3").Select
ActiveCell.FormulaR1C1 = "=FIND(""odd="",R[10]C[-7])+5"
Range("N4").Select
ActiveCell.FormulaR1C1 = "=FIND("""""""",R[9]C7,R[-1]C)"
Range("N5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MID(R[8]C7,R[-2]C,R[-1]C-R[-2]C)*1,""---"")"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R[3]C14:R[3]C15,""---"")=0,R[3]C,"""")"
Range("O3").Select
ActiveCell.FormulaR1C1 = "=FIND(""odd="",R[10]C7,FIND(""odd="",R[10]C7)+5)+5"
Range("O4").Select
ActiveCell.FormulaR1C1 = "=FIND("""""""",R[9]C7,R[-1]C)"
Range("O5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MID(R[8]C7,R[-2]C,R[-1]C-R[-2]C)*1,""---"")"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R[3]C16:R[3]C18,""---"")=0,R[3]C,"""")"
Range("P5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(MAX(R[15]C[-11]:R[28]C[-11]),R[15]C[-11]:R[28]C[-10],2,FALSE)"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R[3]C16:R[3]C18,""---"")=0,R[3]C,"""")"
Range("Q3").Select
ActiveCell.FormulaR1C1 = "=FIND(""odd="",R[11]C[-10])+5"
Range("Q4").Select
ActiveCell.FormulaR1C1 = "=FIND("""""""",R[10]C7,R[-1]C)"
Range("Q5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MID(R[9]C7,R[-2]C,R[-1]C-R[-2]C)*1,""---"")"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R[3]C16:R[3]C18,""---"")=0,R[3]C,"""")"
Range("R3").Select
ActiveCell.FormulaR1C1 = "=FIND(""odd="",R[11]C7,FIND(""odd="",R[11]C7)+5)+5"
Range("R4").Select
ActiveCell.FormulaR1C1 = "=FIND("""""""",R[10]C7,R[-1]C)"
Range("R5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(MID(R[9]C7,R[-2]C,R[-1]C-R[-2]C)*1,""---"")"
Range("R6").Select
'ODDS READING OVERWRITE
Range("K5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(SUBSTITUTE(MID(R[7]C7,R[-2]C,R[-1]C-R[-2]C),""."",R8C6)*1,""---"")"
Range("K5").Select
Selection.AutoFill Destination:=Range("K5:M5"), Type:=xlFillDefault
Range("K5:M5").Select
Range("N5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(SUBSTITUTE(MID(R[8]C7,R[-2]C,R[-1]C-R[-2]C),""."",R8C6)*1,""---"")"
Range("N5").Select
Selection.AutoFill Destination:=Range("N5:O5"), Type:=xlFillDefault
Range("N5:O5").Select
Range("Q5").Select
ActiveCell.FormulaR1C1 = "=IFERROR(SUBSTITUTE(MID(R[9]C7,R[-2]C,R[-1]C-R[-2]C),""."",R8C6)*1,""---"")"
Range("Q5").Select
Selection.AutoFill Destination:=Range("Q5:R5"), Type:=xlFillDefault
Range("Q5:R5").Select
'titles
Range("K1").Select
ActiveCell.FormulaR1C1 = "1"
Range("L1").Select
ActiveCell.FormulaR1C1 = "X"
Range("M1").Select
ActiveCell.FormulaR1C1 = "2"
Range("N1").Select
ActiveCell.FormulaR1C1 = ">2.5"
Range("O1").Select
ActiveCell.FormulaR1C1 = "<2.5"
Range("P1").Select
ActiveCell.FormulaR1C1 = "AHL"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "AH1"
Range("R1").Select
ActiveCell.FormulaR1C1 = "AH2"
Range("AE2").Select
Range("K1:R1").Select
Selection.Copy
Sheets("DATA").Activate
Range(Range("DWN!E1").Value & 1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Private Sub DWN_ODDS()
Application.ScreenUpdating = False
1
If Range("DWN!F2").Value > 0 Then GoTo 2 Else GoTo 3
2
Sheets("DWN").Activate
Application.StatusBar = Range("DWN!F7").Value
START:
Sheets("DWN").Activate
Range("G12").Select
Selection.ClearContents
Dim i As Integer
Dim sURL As String, T As String, sAllPosts As String
Dim oHttp As Object
Dim lTopicstart As Long, lTopicend As Long
Dim blWSExists As Boolean
'URL to open
sURL = Range("DWN!F6").Value
' Create an ServerXMLHTTP object and add some error trapping
On Error Resume Next
Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.ServerXMLHTTPRequest")
MsgBox "Error 0 has occured while creating a MSXML.ServerXMLHTTPRequest object"
End If
On Error GoTo 0
If oHttp Is Nothing Then
MsgBox "For some reason I wasn't able to make a MSXML2.ServerXMLHTTP object"
Exit Sub
End If
'Open the URL in browser object
On Error GoTo START:
oHttp.Open "GET", sURL, False
oHttp.Send
T = oHttp.responseText
SC_ST = Range("DWN!F9").Value
SC_ED = Range("DWN!F10").Value
'Extract the desired information from the returned HTML code (text)
'To make things a little easier I usually cut of most of the unwanted code first
'so sHTML is smaller to work with.
lTopicstart = InStr(1, T, SC_ST, vbTextCompare)
lTopicend = InStr(1, T, SC_ED, vbTextCompare)
'Now extract all text within the hyperlinks <a href..>..</a>
'because they represent the topics
On Error GoTo 10
i = 1
lTopicstart = 1
lTopicend = 1
Do While lTopicstart <> 0
i = i + 1
lTopicstart = InStr(lTopicend, T, SC_ST, vbTextCompare)
If lTopicstart <> 0 Then
lTopicstart = InStr(lTopicstart, T, SC_ST, vbTextCompare) + 1
lTopicend = InStr(lTopicstart, T, SC_ED, vbTextCompare)
T = Left(Mid(T, lTopicstart, lTopicend - lTopicstart), Len(Mid(T, lTopicstart, lTopicend - lTopicstart)) - 1)
sAllPosts = sAllPosts & Chr(13) & Mid(T, lTopicstart, lTopicend - lTopicstart)
End If
Loop
10
Range("G12").Value = T
'Clean up
Set oHttp = Nothing
Application.Run "DWN_OU"
Application.Run "DWN_AH"
Range("A1").Select
Sheets("DWN").Activate
Range("K2:R2").Select
Selection.Copy
Sheets("DATA").Activate
Range(Range("DWN!E1").Value & Range("DWN!F4").Value).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("DWN").Activate
Range("C" & Range("DWN!F4").Value).Value = "#"
GoTo 1
3
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub
Private Sub DWN_OU()
Sheets("DWN").Activate
If Range("EXTRAS_OU").Value = "X" Then GoTo 1 Else GoTo 2
1
START:
Sheets("DWN").Activate
Range("G13").Select
Selection.ClearContents
Dim i As Integer
Dim sURL As String, T As String, sAllPosts As String
Dim oHttp As Object
Dim lTopicstart As Long, lTopicend As Long
Dim blWSExists As Boolean
'URL to open
sURL = Range("DWN!F6").Value & Range("SETTINGS_OU").Value
' Create an ServerXMLHTTP object and add some error trapping
On Error Resume Next
Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.ServerXMLHTTPRequest")
MsgBox "Error 0 has occured while creating a MSXML.ServerXMLHTTPRequest object"
End If
On Error GoTo 0
If oHttp Is Nothing Then
MsgBox "For some reason I wasn't able to make a MSXML2.ServerXMLHTTP object"
Exit Sub
End If
'Open the URL in browser object
On Error GoTo START:
oHttp.Open "GET", sURL, False
oHttp.Send
T = oHttp.responseText
SC_ST = Range("DWN!F13").Value
SC_ED = Range("DWN!F10").Value
'Extract the desired information from the returned HTML code (text)
'To make things a little easier I usually cut of most of the unwanted code first
'so sHTML is smaller to work with.
lTopicstart = InStr(1, T, SC_ST, vbTextCompare)
lTopicend = InStr(1, T, SC_ED, vbTextCompare)
'Now extract all text within the hyperlinks <a href..>..</a>
'because they represent the topics
On Error GoTo 10
i = 1
lTopicstart = 1
lTopicend = 1
Do While lTopicstart <> 0
i = i + 1
lTopicstart = InStr(lTopicend, T, SC_ST, vbTextCompare)
If lTopicstart <> 0 Then
lTopicstart = InStr(lTopicstart, T, SC_ST, vbTextCompare) + 1
lTopicend = InStr(lTopicstart, T, SC_ED, vbTextCompare)
T = Left(Mid(T, lTopicstart, lTopicend - lTopicstart), Len(Mid(T, lTopicstart, lTopicend - lTopicstart)) - 1)
sAllPosts = sAllPosts & Chr(13) & Mid(T, lTopicstart, lTopicend - lTopicstart)
End If
Loop
10
Range("G13").Value = T
'Clean up
Set oHttp = Nothing
2
End Sub
Private Sub DWN_AH_0()
Sheets("DWN").Activate
If Range("EXTRAS_AH").Value = "X" Then GoTo 1 Else GoTo 2
1
URLVal1 = Range("DWN!F6").Value & Range("SETTINGS_AH").Value
'Range("A:AZ").Select
'Selection.Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & URLVal1, Destination:=Range( _
"$AK$10"))
.Name = "TEMP"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
'.WebTables = "1"
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With
2
End Sub
Private Sub DWN_AH()
Sheets("DWN").Activate
Application.Run "DWN_AH_0"
If Range("EXTRAS_AH").Value = "X" Then GoTo 1 Else GoTo 2
1
START:
Sheets("DWN").Activate
Range("G14").Select
Selection.ClearContents
Dim i As Integer
Dim sURL As String, T As String, sAllPosts As String
Dim oHttp As Object
Dim lTopicstart As Long, lTopicend As Long
Dim blWSExists As Boolean
'URL to open
sURL = Range("DWN!F6").Value & Range("SETTINGS_AH").Value
' Create an ServerXMLHTTP object and add some error trapping
On Error Resume Next
Set oHttp = CreateObject("MSXML2.ServerXMLHTTP")
If Err.Number <> 0 Then
Set oHttp = CreateObject("MSXML.ServerXMLHTTPRequest")
MsgBox "Error 0 has occured while creating a MSXML.ServerXMLHTTPRequest object"
End If
On Error GoTo 0
If oHttp Is Nothing Then
MsgBox "For some reason I wasn't able to make a MSXML2.ServerXMLHTTP object"
Exit Sub
End If
'Open the URL in browser object
On Error GoTo START:
oHttp.Open "GET", sURL, False
oHttp.Send
T = oHttp.responseText
SC_ST = Range("DWN!F14").Value
SC_ED = Range("DWN!F10").Value
'Extract the desired information from the returned HTML code (text)
'To make things a little easier I usually cut of most of the unwanted code first
'so sHTML is smaller to work with.
lTopicstart = InStr(1, T, SC_ST, vbTextCompare)
lTopicend = InStr(1, T, SC_ED, vbTextCompare)
'Now extract all text within the hyperlinks <a href..>..</a>
'because they represent the topics
On Error GoTo 10
i = 1
lTopicstart = 1
lTopicend = 1
Do While lTopicstart <> 0
i = i + 1
lTopicstart = InStr(lTopicend, T, SC_ST, vbTextCompare)
If lTopicstart <> 0 Then
lTopicstart = InStr(lTopicstart, T, SC_ST, vbTextCompare) + 1
lTopicend = InStr(lTopicstart, T, SC_ED, vbTextCompare)
T = Left(Mid(T, lTopicstart, lTopicend - lTopicstart), Len(Mid(T, lTopicstart, lTopicend - lTopicstart)) - 1)
sAllPosts = sAllPosts & Chr(13) & Mid(T, lTopicstart, lTopicend - lTopicstart)
End If
Loop
10
Range("G14").Value = T
'Clean up
Set oHttp = Nothing
2
End Sub
Private Sub ODDS()
If Range("EXTRAS_1X2").Value = "X" Or Range("EXTRAS_OU").Value = "X" Or Range("EXTRAS_AH").Value = "X" Then GoTo 1 Else GoTo 2
1
Application.Run "ODDS_PREP"
Application.Run "DWN_ODDS"
'filter
Range("A1:O1").Select
Selection.AutoFilter
Range("A1").Select
'formatting
Sheets("DATA").Activate
Columns(Range("DWN!E1").Value & ":AZ").Select
With Selection
.NumberFormat = "0.00"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range(Range("DWN!E1").Value & "1:AZ1").Select
Selection.NumberFormat = "General"
Range("A1").Select
'tidy up
Sheets("DWN").Activate
Cells.Select
Selection.Clear
Range("A1").Select
2
Sheets("DATA").Activate
End Sub