Extracting tables from multiple websites

Green Squirrel

New Member
Joined
Jan 9, 2021
Messages
25
Office Version
  1. 365
Platform
  1. MacOS
With the help of member John_w I've managed to build a vba script that gets data form a website table. Everything works just the way I want it to work.
But I need multiple tables and each time the website or table name needs to be different.

As you can see below in the script I first get table 10 from the website, put it in Cell B2 and call it LT BE1 Home
In the second sub I'm calling table 11 from the website, put it in Cell B22 (This is one cell below the previous table) and call it LT BE1 Away.
In both cases the URL stays the same

Now I want to do repeat this process for 10 other URL's. So the URL, the destination and table name needs to change each time.

How do I go about this? Do I create 20 (2 tables from 10 different URL's) subs or is there another, more automated way to do this?

VBA Code:
Public Sub ImportTBLHome()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    Dim sFormula As String
    
    Set sourceSheet = Sheet2
    
    TBL = "LT BE1 Home"
    URL = "https://www.soccerstats.com/homeaway.asp?league=belgium"
    
    With sourceSheet
        Set destCell = .Range("B2")
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
    
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "10"
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With

End Sub

Public Sub ImportTBLAway()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    Dim sFormula As String
    
    Set sourceSheet = Sheet2
    
    TBL = "LT BE1 Away"
    URL = "https://www.soccerstats.com/homeaway.asp?league=belgium"
    
    With sourceSheet
        Set destCell = .Range("B22")
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
    
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "11"
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With

End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

Forum statistics

Threads
1,223,275
Messages
6,171,119
Members
452,381
Latest member
Nova88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top