Web Query Loop

**giantfan87** · 06-26-2009, 11:14 AM

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.

Code:

'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

**mudraker** · 06-26-2009, 05:23 PM

For what you are doing there are better methodes than selecting, copying & pasting between sheets whilst still placing required details on sheet 1

The macro loops from row 1 to last used row in column B
It places data from sheet2 into same row that account number is on in sheet1

Code:

Dim lLR As Long
Dim l4Row As Long
Dim sAccNo As String
Dim wSh1 As Worksheet
Dim wSh2 As Worksheet
   
Set wSh1 = Sheet1
Set wSh2 = Sheet2
   
wSh1.Select
'get last used row number in sheet1 column B
lLR = wSh1.Range("b1").End(xlDown).Row
'loop for each enty in sheet1 column B
For l4Row = 1 To lLR Step 1
   If Trim(wSh1.Cells(l4Row, "b").Value) <> "" Then
      'obtain current 2009 data
      sAccNo = wSh1.Cells(l4Row, "B").Value
      
      With Worksheets("Sheet2").QueryTables.Add(Connection:= _
         "URL;http://www.dallascad.org/AcctDetailCom.aspx?ID=" & sAccNo & "]", _
         Destination:=wSh2.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 improvement values from sheet1 to sheet2
      wSh1.Cells(l4Row, "M").Value = wSh2.Range("Q38").Value
      'Copy land value from sheet1 to sheet2
      wSh1.Cells(l4Row, "H").Value = wSh2.Range("Q39").Value
      'Copy land area from sheet1 to sheet2
      wSh1.Cells(l4Row, "E").Value = wSh2.Range("K76").Value
      'Copy improvement area from sheet1 to sheet2
      wSh1.Cells(l4Row, "F").Value = wSh2.Range("E49").Value
      'Copy address from sheet1 to sheet2
      wSh1.Cells(l4Row, "C").Value = wSh2.Range("P8").Value
   
      'Clear all data on sheet2 in preparation for new data to be placed there
      wSh2.Cells.Delete Shift:=xlUp
   End If
Next rCell
wSh1.Range("B2").Select
Set wSh1 = Nothing
Set wSh2 = Nothing

Thread: Web Query Loop

Thread Tools

Display

Web Query Loop

Re: Web Query Loop

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions