Green Squirrel
New Member
- Joined
- Jan 9, 2021
- Messages
- 25
- Office Version
- 365
- Platform
- 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?
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