Looping Web Query.....almost there but not quite.

JuanPablo100

New Member
Joined
Jul 30, 2012
Messages
8
Hi,

Im fairly proficient with Excel but rarely do much intense VBA. Anyway, I have been trying to create a looping macro that effectively takes a list of URL's down column A and outputs the data imported from the website into a separate column. Below is a copy of my code. Anyway, the code works fine but I have had to make a 'clunky' adjustment to the destination for the imported data to prevent it from pasting the data in ajdacent columns (i want it to paste it below the previous (or on top of) the previous data dump so the data works downwards not sidewards). Effectively I change the destination to be 20 rows below the previous paste. The problem is that the data from each of the websites seems to vary between 10 rows and 20 rows (and could possible be greater at some future date). I would like the macro to effectively paste each new data dump directly below the previous one.

I thought I had it figured with the RefreshStyle Property (xLEntireRows) in the web query which is meant to insert new rows to make way for the new data but this doesnt seem to be working. The listed URL's are basically ticker codes for different stocks being pulled from Google Finance (an example list is below) The data is anywhere from 10 to 20 rows down and a few columns wide. Even with the xLEntireRows property chosen the data seems to paste across the page.

http://www.google.com/finance?q=asx:bhp
http://www.google.com/finance?q=asx:rio

Finally, does anybody know if you can put multiple web queries into an iqy file to be run from excel? I am currently running this macro off an old PC and would like to run it from MAC 2011 (which I believe doesnt support web queries) but can import data from Url's specified in an IQY file does work. However, I can only get this to work for a single web query (i.e. a single URL) but was wondering if you could populate the IQY file with multiple URLS and get it to run as a batch. Havent been able to find much info on this but was thinking there should be a way around as being able to only use a single web query would seem to be rather useless I would have thought.

Anyway, any help would be greatly appreciated.

Cheers.
Sub test1()

Dim I As Long, A As String
' declaring variables

With ActiveSheet
I = 2
Do
A = .Cells(I, 1).Value
If A <> "" Then
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & A, Destination:=Cells(2 + 20 * (I - 2), 3))
.Name = I
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
'.WebTables = "1,2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With


End If
I = I + 1
Loop Until A = ""

End With
Beep
End Sub
 

drsarao

Well-known Member
Joined
Sep 9, 2009
Messages
1,112
.RefreshStyle = xlInsertEntireRows causes the data to be pushed down. This will cause the new data to be inserted above previous one.

So you need to change Destination:=Cells(2 + 20 * (I - 2), 3) to Destination:=.Range("C1")

However, if you want the returned data to be inserted below the previous one, then try this:
Code:
Sub test1()
Dim I As Long, A As String
' declaring variables
With ActiveSheet
    I = 2
    Do
        A = .Cells(I, 1).Value
        If A <> "" Then
            [COLOR="#FF0000"]lrc = .Cells(Rows.Count, "C").End(xlUp).Row[/COLOR] 'last row in C column
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & A, Destination:=[COLOR="#FF0000"].Cells(lrc + 1, "C")[/COLOR])
                .Name = I
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertEntireRows
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlAllTables
                .WebFormatting = xlWebFormattingNone
                '.WebTables = "1,2"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
        End If
        I = I + 1
    Loop Until A = ""
End With
Beep
End Sub
 

JuanPablo100

New Member
Joined
Jul 30, 2012
Messages
8
Many thanks. That works perfect. However, I notice that if I change the WebSelectionType=xlAllTables to xlEntirePage (to copy the entire html dump) it copies each new data dump adjacent to the previous column (i.e. 1st web import gets moved across columns to make way for the second data dump and so on). Shouldn't excel be adding new rows and dumping the new data on top of where the previous dump was? Cant figure out what is causing this.
 

drsarao

Well-known Member
Joined
Sep 9, 2009
Messages
1,112
You are welcome and thanks for the feedback.

Many thanks. That works perfect. However, I notice that if I change the WebSelectionType=xlAllTables to xlEntirePage (to copy the entire html dump) it copies each new data dump adjacent to the previous column (i.e. 1st web import gets moved across columns to make way for the second data dump and so on). Shouldn't excel be adding new rows and dumping the new data on top of where the previous dump was? Cant figure out what is causing this.
I would think the same!
Which method are you following? Destination:=.Range("C1")?
 

JuanPablo100

New Member
Joined
Jul 30, 2012
Messages
8
Im using your revised code.

I would post the workbook so you could see but I cant seem to be able to work out how to do this. Apparently my posting permissions do not allow this.

Thanks again for all your help.

Cheers.
 

JuanPablo100

New Member
Joined
Jul 30, 2012
Messages
8
It seems as if this person had the same problem (http://www.mrexcel.com/forum/showthread.php?99051-Web-query-problem). They concluded that it must be a bug in Excel which is what I am thinking because I cant get it to work as documented either. Funny thing is that this was identified as a bug in the 97 version. Im using the 2007 version and its still in there!.....perhaps its been fixed in the 2010 version...not sure.
 

drsarao

Well-known Member
Joined
Sep 9, 2009
Messages
1,112
It seems as if this person had the same problem (http://www.mrexcel.com/forum/showthread.php?99051-Web-query-problem). They concluded that it must be a bug in Excel which is what I am thinking because I cant get it to work as documented either. Funny thing is that this was identified as a bug in the 97 version. Im using the 2007 version and its still in there!.....perhaps its been fixed in the 2010 version...not sure.
Microsoft will obviously call it a "Feature"!

Few suggestions to improve the code otherwise.

1. Add a .Delete within the query With..End With. This will delete the query ONLY. The data returned stays intact. This will avoid file bloating with all those queries.

2. You should delete the Query names also. Otherwise they also fill up pretty fast. Though you put .Name= I (ie the row number number), when you rerun the query, Excel will keep on adding names like 4_001 etc. For getting read of name, you have to first the save the name within With...Endwith and then delete it.

3. Most of the properties are defaults and can be dispensed with (when you record macro, it gives ALL the properties)

4. For..Next loops (if feasible) are better to implement and later debug.


eg:

Code:
Sub test1()
Dim I As Long, A As String, nm As String, lra As Long, lrc As Long [COLOR="#008000"]' declaring variables[/COLOR]
With ActiveSheet
    lra = .Cells(Rows.Count, "A").End(xlUp).Row[COLOR="#008000"] 'last row in column A[/COLOR]
    For I = 2 To lra  [COLOR="#008000"]'cycle thru all rows[/COLOR]
        A = .Cells(I, 1).Value
        If A <> "" Then
            lrc = .Cells(Rows.Count, "C").End(xlUp).Row [COLOR="#008000"]'last row in C column[/COLOR]
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & A, Destination:=.Cells(lrc + 1, "C"))
                .Name = I   [COLOR="#008000"]'redundant as we are saving and then deleting the name[/COLOR]
                .RefreshStyle = xlInsertEntireRows
                .SaveData = True  [COLOR="#008000"]'applicable to Pivot Table only I think. I removed it without any ill effects[/COLOR]
                .WebSelectionType = xlAllTables
[COLOR="#008000"]                '.WebTables = "1,2"
                '.FieldNames = True
                '.RowNumbers = False
                '.FillAdjacentFormulas = False
                '.PreserveFormatting = True
                '.RefreshOnFileOpen = False
                '.BackgroundQuery = True  duplicated in .Refresh line
                '.SavePassword = False  applicable to ODBC queries only
                '.AdjustColumnWidth = True
                '.RefreshPeriod = 0  disable auto refresh
                '.WebFormatting = xlWebFormattingNone
                '.WebPreFormattedTextToColumns = True
                '.WebConsecutiveDelimitersAsOne = True
                '.WebSingleBlockTextImport = False
                '.WebDisableDateRecognition = False
                '.WebDisableRedirections = False[/COLOR]
                .Refresh BackgroundQuery:=False  'should come AFTER all property settings
                [COLOR="#FF0000"]nm = .Name  'save name
                .Delete  'delete query. should come AFTER .Refresh[/COLOR]
            End With
            [COLOR="#FF0000"].Names(nm).Delete  'delete name[/COLOR]
        End If
    Next I
End With
Beep
End Sub
 

JuanPablo100

New Member
Joined
Jul 30, 2012
Messages
8
Fantastic!!!....Ain particular the delete addition has really removed a lot of bloat!!!

I found your 4th comment interesting. Havent had a problem with the Do statement for this module but I have been stumped on other modules where I couldnt figure out what was wrong and have ended up changing to a FOR statement even if it wasnt as suitable. Thought it was just me but interesting that you point out that a DO statement is less stable.


Microsoft will obviously call it a "Feature"!

Few suggestions to improve the code otherwise.

1. Add a .Delete within the query With..End With. This will delete the query ONLY. The data returned stays intact. This will avoid file bloating with all those queries.

2. You should delete the Query names also. Otherwise they also fill up pretty fast. Though you put .Name= I (ie the row number number), when you rerun the query, Excel will keep on adding names like 4_001 etc. For getting read of name, you have to first the save the name within With...Endwith and then delete it.

3. Most of the properties are defaults and can be dispensed with (when you record macro, it gives ALL the properties)

4. For..Next loops (if feasible) are better to implement and later debug.


eg:

Code:
Sub test1()
Dim I As Long, A As String, nm As String, lra As Long, lrc As Long [COLOR=#008000]' declaring variables[/COLOR]
With ActiveSheet
    lra = .Cells(Rows.Count, "A").End(xlUp).Row[COLOR=#008000] 'last row in column A[/COLOR]
    For I = 2 To lra  [COLOR=#008000]'cycle thru all rows[/COLOR]
        A = .Cells(I, 1).Value
        If A <> "" Then
            lrc = .Cells(Rows.Count, "C").End(xlUp).Row [COLOR=#008000]'last row in C column[/COLOR]
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & A, Destination:=.Cells(lrc + 1, "C"))
                .Name = I   [COLOR=#008000]'redundant as we are saving and then deleting the name[/COLOR]
                .RefreshStyle = xlInsertEntireRows
                .SaveData = True  [COLOR=#008000]'applicable to Pivot Table only I think. I removed it without any ill effects[/COLOR]
                .WebSelectionType = xlAllTables
[COLOR=#008000]                '.WebTables = "1,2"
                '.FieldNames = True
                '.RowNumbers = False
                '.FillAdjacentFormulas = False
                '.PreserveFormatting = True
                '.RefreshOnFileOpen = False
                '.BackgroundQuery = True  duplicated in .Refresh line
                '.SavePassword = False  applicable to ODBC queries only
                '.AdjustColumnWidth = True
                '.RefreshPeriod = 0  disable auto refresh
                '.WebFormatting = xlWebFormattingNone
                '.WebPreFormattedTextToColumns = True
                '.WebConsecutiveDelimitersAsOne = True
                '.WebSingleBlockTextImport = False
                '.WebDisableDateRecognition = False
                '.WebDisableRedirections = False[/COLOR]
                .Refresh BackgroundQuery:=False  'should come AFTER all property settings
                [COLOR=#FF0000]nm = .Name  'save name
                .Delete  'delete query. should come AFTER .Refresh[/COLOR]
            End With
            [COLOR=#FF0000].Names(nm).Delete  'delete name[/COLOR]
        End If
    Next I
End With
Beep
End Sub
 

drsarao

Well-known Member
Joined
Sep 9, 2009
Messages
1,112
Do..While is as stable and has to be used in some conditions.
But when a counter is being used (as in your original code), it is better to use For..Next as the counter is built-in.
Debugging is a whole lot easier.
 

Forum statistics

Threads
1,081,420
Messages
5,358,574
Members
400,504
Latest member
RedSquirrel

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top