Hi,
Looking for some help updating some vba code that Bertie had previously helped me out with. The code provided was as follows:
The code previously worked as I wanted and downloaded all football fixtures for a chosen league from the BBC football website (Premier League - Scores & Fixtures - Football - BBC Sport). The output is something similar to the below, with home team, "vs." away team and kick off times all in separate columns.
[TABLE="width: 416"]
<tbody>[TR]
[TD]Match Day 01[/TD]
[TD="colspan: 2"]12th August 2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Fixture[/TD]
[TD][/TD]
[TD]Kick-off[/TD]
[/TR]
[TR]
[TD]Arsenal[/TD]
[TD]vs.[/TD]
[TD]Leicester City[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]Brighton & Hove Albion[/TD]
[TD]vs.[/TD]
[TD]Manchester City[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]Chelsea[/TD]
[TD]vs.[/TD]
[TD]Burnley[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]Crystal Palace[/TD]
[TD]vs.[/TD]
[TD]Huddersfield Town[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]Everton[/TD]
[TD]vs.[/TD]
[TD]Stoke City[/TD]
[TD]15:00[/TD]
[/TR]
</tbody>[/TABLE]
However the BBC have recently changed their website and have split it into fixtures per month rather than listing them for the whole season; and now the vba code no longer downloads the fixtures.
Can anyone advise how this should be updated allow the fixtures to be downloaded again?
I'm not concerned about what web site the fixtures come from if an alternative is more suitable, all I would like is the fixtures to be downloaded as above in separate columns.
Thanks,
EMcK
Looking for some help updating some vba code that Bertie had previously helped me out with. The code provided was as follows:
Code:
Sub Main()
Dim rng As Range
Dim sUrl As String
Dim sSheetName As String
Dim sNumTables As String
Set rng = Sheets("Data").Range("A6")
Do Until rng = ""
sUrl = rng.Value
sSheetName = rng.Offset(, 1).Value
sNumTables = rng.Offset(, 2).Value
ImportFromWeb sUrl, sSheetName, sNumTables
TidyUp (sSheetName)
InserBlankRows (sSheetName)
Set rng = rng.Offset(1, 0)
Loop
End Sub
Code:
Private Sub ImportFromWeb(ByVal sUrl As String, _
ByVal sSheetName As String, _
ByVal sNumTables As String)
'copy the template
Sheets("Template").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sSheetName
With Sheets(sSheetName).QueryTables.Add(Connection:= _
"URL;" & sUrl, _
Destination:=Sheets(sSheetName).Range("$A$1"))
.Name = "fixtures-data"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = sNumTables
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
Code:
Private Sub TidyUp(sSheetName As String)
'Insert blank column
For colx = 3 To 6 Step 1
Columns(colx).Insert shift:=xlToRight
Next
'Delete column
With Sheets(sSheetName)
.Columns("H:H").EntireColumn.Delete
End With
Dim numRows As Long
Dim arrFixture As Variant
Dim rw As Long
With Sheets(sSheetName)
'get the number of rows
numRows = .Cells(.Rows.Count, "B").End(xlUp).Row
For rw = 4 To numRows
'test for "V " is in string, if so, split into array and process
If InStr(.Range("B" & rw).Value, "V ") Then
arrFixture = Split(.Range("B" & rw).Value, "V ") 'split strin on V followed by space
'output
.Range("D" & rw).Value = arrFixture(0)
.Range("E" & rw).Value = "vs."
.Range("F" & rw).Value = arrFixture(1)
End If
Next rw
End With
The code previously worked as I wanted and downloaded all football fixtures for a chosen league from the BBC football website (Premier League - Scores & Fixtures - Football - BBC Sport). The output is something similar to the below, with home team, "vs." away team and kick off times all in separate columns.
[TABLE="width: 416"]
<tbody>[TR]
[TD]Match Day 01[/TD]
[TD="colspan: 2"]12th August 2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Fixture[/TD]
[TD][/TD]
[TD]Kick-off[/TD]
[/TR]
[TR]
[TD]Arsenal[/TD]
[TD]vs.[/TD]
[TD]Leicester City[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]Brighton & Hove Albion[/TD]
[TD]vs.[/TD]
[TD]Manchester City[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]Chelsea[/TD]
[TD]vs.[/TD]
[TD]Burnley[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]Crystal Palace[/TD]
[TD]vs.[/TD]
[TD]Huddersfield Town[/TD]
[TD]15:00[/TD]
[/TR]
[TR]
[TD]Everton[/TD]
[TD]vs.[/TD]
[TD]Stoke City[/TD]
[TD]15:00[/TD]
[/TR]
</tbody>[/TABLE]
However the BBC have recently changed their website and have split it into fixtures per month rather than listing them for the whole season; and now the vba code no longer downloads the fixtures.
Can anyone advise how this should be updated allow the fixtures to be downloaded again?
I'm not concerned about what web site the fixtures come from if an alternative is more suitable, all I would like is the fixtures to be downloaded as above in separate columns.
Thanks,
EMcK