Creating a Dynamic Macro/Query where URL Changes

uxler

New Member
Joined
Jul 19, 2010
Messages
5
I'm trying to query a page in which I need to change parts of the url based on the information I want. Heres the url (with domain changed to protect info, rest is identical) I am trying to work with:

http://website.com/flb/recentactivity?leagueId=33991&seasonId=2010&activityType=2&startDate=20100218&endDate=20100719&teamId=-1&tranType=4

I want to be able to change the parameters in bold. I have all of the parameters in a table, so if i could get the macro to reference the table thatd prob be easiest. In fact, the table is set up to combine parameters and automatically generate the URL I want. So I really just need the macro to reference one cell within the workbook to get the approriate URL I want query.

Whats the best way to do this? Hope my questioning isnt to confusing. Thanks!
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Uxler,

Am I correct in assuming that you have a long list of URLs that you need to query at the same time?

If you want to come up with a table where one column is the URL that you already have and another column is some output from the webpage that you are querying I could show you how to loop through all of the URLs and do this but I want to make sure that is what you are actually looking for...
 
Upvote 0
Here is a code that should accomplish what you're looking for...

This assumes that your URLs are located in column A from row 1 to 50, and the info you want is in webtable #1. That can obviously be changed.

Code:
Sub Download_Data()
    For a = 1 To 50
        myurl = Trim(Cells(a, 1))
        strname = Trim(Cells(a, 1))
        querydata myurl, a, strname
    Next a
End Sub
Sub querydata(Q_url, strrow, strname)
    Dim StrRange As Range
    Dim sConn As String
    Dim sSql As String
    Dim qt As QueryTable
    Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ws.Activate
'clear querytables
For Each qt In ActiveSheet.QueryTables
    qt.Delete
Next qt
sConn = "URL;" & Q_url
sSql = ""
Set qt = ActiveSheet.QueryTables.Add( _
        Connection:=sConn, _
        Destination:=ws.Cells(1, 12))
With qt
    .Name = strname
    .WebTables = "1"
    .RefreshStyle = xlOverwriteCells
End With
    qt.Refresh BackgroundQuery:=False

writetocell (strrow)
End Sub
Sub writetocell(strrow)

Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ws.Activate

'Change from a live query to values
Range("YOUR DOWNLOADED DATA").Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

'Copy the results from the temp location into correct position
Range("YOUR DOWNLOADED DATA").Copy
Cells(strrow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=True
    
'Clear cells @ end
Range("YOUR DOWNLOADED DATA").Select
Selection.ClearContents
End Sub
This code works by connecting to the URL, downloading the data into a temporary location in the worksheet, then copying the data from the temporary location to wherever you would like it.

The advantage to this method is that you can take a large table from a webpage and end up with only the part of it you want. Or you can take a column of data and easily transpose it into rows - as I often do.

You will most likely need to change the For...To part based on the number of URLs you have, and the webtable #. You will also need to change 'Range("YOUR DOWNLOADED DATA")' based on the size of the table you are downloading.

If you want help changing the code I will need to know the size and layout of the table that you are querying and how you want it formatted in your worksheet. Let me know if you have any further questions.
 
Upvote 0
Thanks a bunch, think this is just what i was looking for. Think ive got most of the code changed, but what would I put in the Range ("YOUR DOWNLOADED DATA HERE") section. Usually try to figure this stuff out myself but Im a novice with VB.

My specs are as follows:

- 24 Total Queries with URL's in Sheet 1 A1:A24
- Queried Data is in 3rd selectable table on page, 4 columns wide, # of rows varies

With these specs, what would the code look like. Thanks again!
 
Last edited:
Upvote 0
The size of the range will depend on how many rows from the website that you want to capture.

Example: the temporary range where the webtable shows up before you copy it into its final place is set to start at L1 and continue down and to the right depending on the size of the table that is downloaded. So if the table on the website was four columns wide and 10 rows long the actual web query would end up in Range("L1:U10"). Lets say that you wanted all of the data from the second column... You would replace Range("YOUR DOWNLOADED DATA") with Range("M1:M10") That column would then be transposed as a row beside each URL.

Here is the code with the specs you mentioned and my example from above as the range that you would be copying into the row of the URL.

Code:
Sub Download_Data()
    For a = 1 To 24
        myurl = Trim(Cells(a, 1))
        strname = Trim(Cells(a, 1))
        querydata myurl, a, strname
    Next a
End Sub
Sub querydata(Q_url, strrow, strname)
    Dim StrRange As Range
    Dim sConn As String
    Dim sSql As String
    Dim qt As QueryTable
    Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ws.Activate
'clear querytables
For Each qt In ActiveSheet.QueryTables
    qt.Delete
Next qt
sConn = "URL;" & Q_url
sSql = ""
Set qt = ActiveSheet.QueryTables.Add( _
        Connection:=sConn, _
        Destination:=ws.Cells(1, 12))
With qt
    .Name = strname
    .WebTables = "3"
    .RefreshStyle = xlOverwriteCells
End With
    qt.Refresh BackgroundQuery:=False

writetocell (strrow)
End Sub
Sub writetocell(strrow)

Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ws.Activate

'Change from a live query to values
Range("M1:M10").Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

'Copy the results from the temp location into correct position
Range("M1:M10").Copy
Cells(strrow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=True
    
'Clear web query at end
Range("L1:U10").Select
Selection.ClearContents
End Sub
Here is a related suggestion: If the number of URLs might change in the future it would make sense to tell the macro to just count down to the end of column A and loop the query through all rows containing values (which makes sense if the only thing you have in that column are URLs)

This can be done by deleting the line that says "For a=1 to 24" and putting this in its place:
Code:
dim  lastrow as long
lastrow=cells(rows.count, 1).end(xlup).row
for  a=1 to lastrow

That will ensure that the macro continues to work in the future if the number of URLs in column A changes.

It's not the most efficient code in the world but it should do the trick.
 
Upvote 0
keep getting this error :

Run-time error 9
subscript out of range

When i try to debug, this line of code is highlighted:

Set ws = Worksheets("Sheet1")
 
Upvote 0
It's looking for a sheet named Sheet1.

Just change 'Sheet1' to the name of the sheet with your URLs on it.
 
Upvote 0
It's looking for a sheet named Sheet1.

Just change 'Sheet1' to the name of the sheet with your URLs on it.


I need a macro to gain time in my data extraction but I have problem with the codes.

So, I tried to adapt the codes I found in this thread to capture table from a website but it was not producing the values.

Can someone please help? The website is in sheet1; a1 and the table to pe pasted in b5

I was successful to import from website using the data option and the product is like this WORKBOOK

Code:
Sub Download_Data()
    Dim lastrow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To lastrow
        myurl = Trim(Cells(a, 1))
        strname = Trim(Cells(a, 1))
        querydata myurl, a, strname
    Next a
End Sub
Sub querydata(Q_url, strrow, strname)
    Dim StrRange As Range
    Dim sConn As String
    Dim sSql As String
    Dim qt As QueryTable
    Dim ws As Worksheet
Set ws = Worksheets("Hoja1")
ws.Activate
'clear querytables
For Each qt In ActiveSheet.QueryTables
    qt.Delete
Next qt
sConn = "URL;" & Q_url
sSql = ""
Set qt = ActiveSheet.QueryTables.Add( _
        Connection:=sConn, _
        Destination:=ws.Cells(1, 12))
With qt
    .Name = strname
    .WebTables = "1"
    .RefreshStyle = xlOverwriteCells
End With
    qt.Refresh BackgroundQuery:=False


writetocell (strrow)
End Sub
Sub writetocell(strrow)


Dim ws As Worksheet
Set ws = Worksheets("Hoja1")
ws.Activate


'Change from a live query to values
Range("B5:G100").Copy
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False


'Copy the results from the temp location into correct position
Range("B5:G100").Copy
Cells(strrow, 2).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=True
    
'Clear cells @ end
Range("AA1:AR95").Select
Selection.ClearContents
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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