VBA Loop through row until blank and variable use - excel

Question

The code below is a web page table scraper that I am using and it works nicely. It currently only opens the hyperlink that is in location 'L4' using .Open "GET", Range("L4"), False
Sub ImportData()
'Objects
Dim htm As Object
Dim Tr As Object
Dim Td As Object
Dim Tab1 As Object
'Create HTMLFile Object
Set HTML_Content = CreateObject("htmlfile")
'Get the WebPage Content to HTMLFile Object
On Error GoTo Error
With CreateObject("msxml2.xmlhttp")
.Open "GET", Range("L4"), False 'Cell that contains hyperlink
.send
HTML_Content.body.innerHTML = .responseText
End With
On Error GoTo Error
'Add New Worksheet
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = "ESTIMATE"
'Set table variables
Column_Num_To_Start = 1
iRow = 2
iCol = Column_Num_To_Start
iTable = 0
'Loop Through Each Table and Download it to Excel in Proper Format
For Each Tab1 In HTML_Content.getElementsByTagName("table")
With HTML_Content.getElementsByTagName("table")(iTable)
For Each Tr In .Rows
For Each Td In Tr.Cells
Sheets(2).Cells(iRow, iCol).Select
Sheets(2).Cells(iRow, iCol) = Td.innerText
iCol = iCol + 1
Next Td
iCol = Column_Num_To_Start
iRow = iRow + 1
Next Tr
End With
iTable = iTable + 1
iCol = Column_Num_To_Start
iRow = iRow + 1
Next Tab1
'Success
'Loop to find authorised hours string
Dim rng1 As Range
Dim strSearch As String
strSearch = "Hours"
Set rng1 = Range("A:A").Find(strSearch, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
'Add Value to Sheet1
Sheets(1).Range("E4").Value = rng1.Offset(0, 1)
Else
Sheets(1).Range("E4").Value = 0
End If
strSearch = "Actual Hours"
Set rng1 = Range("A:A").Find(strSearch, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
Sheets(1).Range("D4").Value = rng1.Offset(0, 1)
Else
Sheets(1).Range("D4").Value = 0
'Move on to next
End If
strSearch = "Name"
Set rng1 = Range("A:A").Find(strSearch, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
Sheets(1).Range("J4").Value = rng1.Offset(0, 1)
Else
Sheets(1).Range("J4").Value = "NULL"
End If
'Scrape Description
Dim desc As String
HTML_Content.getElementsByTagName ("div")
desc = HTML_Content.getElementsByTagName("p")(0).innerText
Sheets(1).Range("K4").Value = desc
'Keep Sheet 1 Open
Sheets(1).Activate
'Delete ESTIMATE Sheet
Application.DisplayAlerts = False
Sheets(2).Delete
Application.DisplayAlerts = True
Error:
End Sub
The starting row of the hyperlink is L4, how could I make a loop that cycles through all links located in the L column and runs this script for each hyperlink that is in column L? How would I make a variable to so that Range will know what row is currently being processed?
Could I put my code into something like this:
For Each i In Sheet1.Range("L4:L200")
' code here
Next i
Any help is much appreciated, thank you.

Answer 1

change
Sub ImportData()
...
.Open "GET", Range("L4"), False 'Cell that contains hyperlink
...
into
Sub ImportData(urlToOpen as string)
...
.Open "GET", urlToOpen, False 'Cell that contains hyperlink
...
and add a calling procedure:
Sub CallRangeL_Urls
For Each i In Sheet1.Range("L4:L200")
' code here
call ImportData(i)
Next i
end sub
UPDATE 1
To get data from the procedure you might either send it back into the main procedure or you prepare a place prior to calling the procedure:
either:
Sub CallRangeL_Urls
For Each i In Sheet1.Range("L4:L200")
' code here
call ImportData(i, returnValue)
i.offset(0,1).value = returnValue
Next i
end sub
Sub ImportData(urlToOpen as string, returnValue as string)
...
'returnValue = Data you want to give back
returnValue = DataSource...(I didn't read your code again ;-)
...
or:
Sub CallRangeL_Urls
Dim targetRange as Range
For Each i In Sheet1.Range("L4:L200")
' code here
sheets.add after:=sheets(1)
'set a link on the sheet
Range("A1").value = i
Set targetRange = Range("A3")
call ImportData(i, targetRange)
Next i
end sub
Sub ImportData(urlToOpen as string, target as range)
...
'Save whatever data to the new sheet
target.offset(0,0).value = datavalue1 'Range("A3")
target.offset(1,0).value = datavalue1 'Range("A4")
target.offset(2,0).value = datavalue1 'Range("A5")
...
UPDATE 2
UPDATE 2: single data items (working example)
Option Explicit
Sub CallRangeL_Urls()
Dim iCell As Range
Dim Sheet1 As Worksheet
Dim returnValue As String
Set Sheet1 = ActiveSheet
For Each iCell In Sheet1.Range("L4:L4")
' code here
Debug.Print "url: "; iCell.Value
Call ImportData(iCell.Value, returnValue)
iCell.Offset(0, 1).Value = returnValue
Debug.Print returnValue
Next iCell
End Sub
Sub ImportData(urlToOpen As String, ByRef returnValue As String)
'...
'returnValue = Data you want to give back
returnValue = "This is the data we get back from yourUrl: " & urlToOpen & " - DATA/DATA/DATA" 'DataSource...(I didn't read your code again ;-)
End Sub
Immediate window:
url: www.google.de
This is the data we get back from yourUrl: www.google.de - DATA/DATA/DATA
UPDATE 2: data on result sheet(s) (working example)
Option Explicit
Sub CallRangeL_Urls()
Dim iCell As Range
Dim targetRange As Range
Dim Sheet1 As Worksheet
Set Sheet1 = ActiveSheet
For Each iCell In Sheet1.Range("L4:L4")
'create a new "RESULTS" sheets
Sheets.Add after:=Sheets(1)
Debug.Print "New sheet created: " & ActiveSheet.Name
'set a link on the sheet
Range("A1").Value = iCell.Value 'leave a copy of the url on the sheet as a reference
Set targetRange = Range("A3") 'here we want to get the results
Call ImportData(iCell.Value, targetRange)
Next iCell
End Sub
Sub ImportData(urlToOpen As String, target As Range)
Dim datavalue1, datavalue2, datavalue3
'...
datavalue1 = "data value 1"
datavalue2 = "data value 2"
datavalue3 = "data value 3"
'Save whatever data to the new sheet
target.Offset(0, 0).Value = datavalue1 'Range("A3")
target.Offset(1, 0).Value = datavalue2 'Range("A4")
target.Offset(2, 0).Value = datavalue3 'Range("A5")
Debug.Print "datavalues stored on sheet: " & target.Parent.Name
'...
End Sub
Immediate window:
New sheet created: Sheet2
datavalues stored on sheet: Sheet2