Extracting table form website and display it in an excel table

[Green Squirrel]

This is my 1st post on this website so please be kind

I want to pull some table from a website to excel and show them in Excel tables. You might be wondering why I don't use Power Query. Well I'm a Mac user....

I've already managed to pull the table that I want but I just can't figure out how to put this data in an Excel table. Been working on this for days and I just don't succeed.

Public Sub importMatches()

    Dim QT As QueryTable
    Dim URL As String
        
    URL = "https://www.soccerstats.com/matches.asp?matchday=6"
    
    Set QT = Sheet1.QueryTables.Add( _
                    Connection:="URL;" & URL, _
                    Destination:=Sheet1.Range("B2"))
                     
    With QT
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = False
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "7"
        .BackgroundQuery = False
        .Refresh
    End With
    
    ' Set a reference to the result range
    Dim qtResultRange As Range
    Set qtResultRange = QT.ResultRange
    
    ' Define the column numbers to delete
    Dim colsToDelete As Variant
    colsToDelete = Array(2, 3, 5, 6, 8, 9, 10)
    
    ' Delete from end to beginning
    Dim counter As Long
    For counter = UBound(colsToDelete) To 0 Step -1
        qtResultRange.Columns(colsToDelete(counter)).EntireColumn.Delete
    Next counter

End Sub

 

[John_w]

Welcome to MrExcel forums.

To convert the data to a table you must first delete the query table, since a query result range can't occupy/overlap the same cells as a table, and then convert the query result range to a table.

Try this:

Public Sub ImportMatches()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
        
    URL = "https://www.soccerstats.com/matches.asp?matchday=6"
    
    With Sheet1
        Set destCell = .Range("B2")
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
    With QT
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = False
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "7"
        .BackgroundQuery = False
        .Refresh
        ' Set a reference to the result range
        Set qtResultRange = .ResultRange
        .Delete 'must delete QueryTable to convert its result range to a table
    End With
    
    ' Define the column numbers to delete
    Dim colsToDelete As Variant
    colsToDelete = Array(2, 3, 5, 6, 8, 9, 10)
    
    ' Delete from end to beginning
    Dim counter As Long
    For counter = UBound(colsToDelete) To 0 Step -1
        qtResultRange.Columns(colsToDelete(counter)).EntireColumn.Delete
    Next counter

    'Convert data range to a table
    
    With destCell
        .Worksheet.ListObjects.Add xlSrcRange, .CurrentRegion, , xlYes
    End With

End Sub

 

[Green Squirrel]

Hi John,

Thank you very much. But now I can't update the table anymore? Any idea?

 

[John_w]

With the changes below you can now run the macro again to refresh the query and update the table.

Public Sub ImportMatches()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
        
    URL = "https://www.soccerstats.com/matches.asp?matchday=6"
    
    With Sheet1
        Set destCell = .Range("B2")
        On Error Resume Next
        'Delete webData table if it already exists
        .ListObjects("webData").Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
    With QT
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = False
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "7"
        .BackgroundQuery = False
        .Refresh
        ' Set a reference to the result range
        Set qtResultRange = .ResultRange
        .Delete 'must delete QueryTable to convert its result range to a table
    End With
    
    ' Define the column numbers to delete
    Dim colsToDelete As Variant
    colsToDelete = Array(2, 3, 5, 6, 8, 9, 10)
    
    ' Delete from end to beginning
    Dim counter As Long
    For counter = UBound(colsToDelete) To 0 Step -1
        qtResultRange.Columns(colsToDelete(counter)).EntireColumn.Delete
    Next counter

    'Delete the note at bottom of data
    
    qtResultRange.Item(qtResultRange.Rows.Count, 1).ClearContents
    
    'Convert data range to a table named webData
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = "webData"
    End With

End Sub

 

[Green Squirrel]

This is perfect! Thank you very much