Thread: Web Query Loop

What I am trying to do is to have the macro repeat for the each account number entered in column B. What I think needs to be done is to change the location of where the macro puts specific data on sheet1 to a range that corresponds with the account number that has been looked up on the URL. Then I need to get it to loop and repeat the process for each account number. I'm assuming I would have to remove the prompt to enter the account number so it can do all of them.


Here is what the macro does. It first performs a web query. It prompts the user to enter an account number. It then goes to the website and pulls all of the tables for the specific account number and puts them on sheet2 of the workbook. The macro then goes to sheet2 and pulls the necessary data and puts it onto the corresponding columns in sheet one.

Sub URL_Get_AllQuery_and_Sort()
Dim AccountNumber As Range

'obtain current 2009 data
With Worksheets("Sheet2").QueryTables.Add(Connection:= _
"URL;http://www.dallascad.org/AcctDetailCom.aspx?ID=[""AccountNumber"",""Enter Account Number. GO GATORS!!!.""]", _
Destination:=Worksheets("Sheet2").Range("a1"))
'This pastes the entire webpage onto sheet2 of the workbook
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SaveData = True
End With

'Take needed values from sheet2 and copy them into appropriate columns in sheet1
'Copy and paste 2009 improvement values from sheet1 to sheet2
Sheets("Sheet2").Select
Range("Q38").Select
Selection.Copy
Sheets("Sheet1").Select
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Copy and paste 2009 land value from sheet1 to sheet2
Sheets("Sheet2").Select
Range("Q39").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Copy and paste land area from sheet1 to sheet2
Sheets("Sheet2").Select
Range("K76").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Copy and paste improvement area from sheet1 to sheet2
Sheets("Sheet2").Select
Range("E49").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Copy and paste address from sheet1 to sheet2
Sheets("Sheet2").Select
Range("P8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
'Clear all data on sheet2 in preparation for new data to be placed there
Sheets("Sheet2").Select
Cells.Select
Range("K4").Activate
Selection.Delete Shift:=xlUp
Range("K4").Select
Sheets("Sheet1").Select
End Sub