Pull web data from multiple cell references using VBA

**pkow** · 07-09-2011, 11:16 AM

I'd appreciate any help I can get. Thanks!

What I am trying to accomplish:

I have a list of websites in column B of my "Links" tab. (The # of links may vary)
I want to export data from each website in a loop into cell B1 in my "Results" tab
I want to paste the resulting summary info into my "Summary" tab. Cells A2:AK3 contain the information and i want to paste the results starting in cell A5 on my Summary tab and for each new website, paste 2 rows below where I previously pasted the info.

The code I have now is the begginning of what I think I need to do. I am getting an error in the ".Refresh BackgroundQuery:=False" line of code.

        Sub Loops()
    Dim i As Long
    
        For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
         ActiveWorkbook.Worksheets.Add
     With ActiveSheet.QueryTables.Add(Connection:="URL;" & Range("$B$" & i).Value, Destination:=Range("$B$1"))
        .Name = Range("B" & i).Value
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2,3,7"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        Next i

**pkow** · 07-09-2011, 02:34 PM

I have been making some progress. I will update with a solution if I indeed have figured this out. Just don't want others spending time on this problem yet.

**pkow** · 07-09-2011, 05:42 PM

So I have fixed up the code so it basically does what my goal was. The 1 issue is that every time Excel stops responding at a different point while it's "Connecting to the web...". I'm not sure if I should be clearing up the memory each loop, or there is some other problem but any help would be appreciated. Thanks.

     
        Sub Loops()
    Dim i As Long
    
        For i = 3 To 269
        Sheets("Links").Select
     With ActiveSheet.QueryTables.Add(Connection:="URL;" & Range("$B$" & i).Value, Destination:=Range("$G$1"))
        .Name = Range("B" & i).Value
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2,3,7"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
        Sheets("Links").Select
        Range("G1:AG54").Select
        Selection.copy
        Sheets("Results").Select
        Range("B1").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Sheets("Links").Select
        Range("A" & i).Select
        Selection.copy
        Sheets("Summary").Select
        Range("B2:B3").Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Sheets("Summary").Select
        Range("A2:AK3").Select
        Selection.copy
        Range("A" & 2 * i).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Next i
        
End Sub