VBA retrieve football fixtures from web

[EMcK01]

Hi,

Looking for some help updating some vba code that Bertie had previously helped me out with. The code provided was as follows:

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

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

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.

Match Day 01	12th August 2017
	Fixture		Kick-off
Arsenal	vs.	Leicester City	15:00
Brighton & Hove Albion	vs.	Manchester City	15:00
Chelsea	vs.	Burnley	15:00
Crystal Palace	vs.	Huddersfield Town	15:00
Everton	vs.	Stoke City	15:00

<tbody>
</tbody>

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