Pulling data from webpage and placing in multiple columns and loop procedure

Excel 2010 vba:
Pulling data in from website and placing on sheet.

What I have:
Code that does a single pass on the html data and places it on the worksheet.

I have this url string in ColumnA on the worksheet.
http://www.grainger.com/search?searchQuery=CLAW HAMMER 16

Once the website is reached and results returned on the webpage.
The code will mak a single pass and place the data on the sheet. ColumnB


What I need:
I have in an array several metatags that i need placed on the sheet starting at column B to Column D


Problems:
I may have several results to return to the sheet.

So i need to loop through the html page and grab all necessary data.
and loop through the tags and place them on the sheet.


Example:
Right now with a sinple pass the result is returning.


Single Pass
Column A                                                                                                     Column B
http://www.grainger.com/search?searchQuery=CLAW HAMMER 16               4RY57


Make a Pass through ALL the html data:
Example:
Column

  B             C          D                                  E
6R252 STANLEY 51-616     Claw Hammer, 16 Oz, Polished, Hickory
6XV65 STANLEY 51-942     Rip Claw Hammer, 16 Oz, Smooth, Steel
 

etc.....

Option Explicit

Sub TestScreenScraping()
  Dim webpage As String
  Dim i As Long, j As Long
  Dim sFind As String, SKU As String
  Dim cel As Range, rg As Range
  Dim arr
  Dim TAG As String
  
  arr = Array("data-sku=""", "class=""productBrand"">", "class=""productMFR""> | Mfr. Model # <span class=""productInfoValueList"">", "class=""productLink"" title=""")

  
  With Worksheets("Sheet1")
    Set rg = .Range("A1")       'First URL to check
    If rg.Offset(1, 0) <> "" Then Set rg = Range(rg, rg.End(xlDown))    'All the URLs in that column
  End With
     
    
 ' =======================    MULTI PAGE RESULT   ===============================
  
    
       ' FINDS JUST A SKU FROM A MULTIPAGE RESULT
    sFind = "data-sku="""
   ' FINDS MFGNAME FROM A MULTIPAGE RESULT WITH GARBAGE
' sFind = "class=""productBrand"">"
 ' FINDS MFGNUMBER FROM A MULTIPAGE RESULT WITH GARBAGE
' sFind = "class=""productMFR""> | Mfr. Model # <span class=""productInfoValueList"">"
    ' FINDS DESCRIPTION FROM A MULTIPAGE RESULT
'     sFind = "class=""productLink"" title="""
    
    ' FINDS pagenumber FROM A MULTIPAGE RESULT
  '  sFind = "class=""productCatalog""> Catalog Page #"
    
    
    
    
 ' =======================    MULTI PAGE RESULT   ===============================
  For Each cel In rg.Cells
    If cel.Value <> "" Then
      webpage = ""
      i = 0
      j = 0
      SKU = ""
      webpage = GetWebpage(cel.Value)
      
      i = InStr(1, webpage, sFind)
      If i > 0 Then
        i = i + Len(sFind)
        j = InStr(i, webpage, """")
        If j > 0 Then
          SKU = Mid$(webpage, i, j - i)
        End If
      End If
    End If
    cel.Offset(0, 1).Value = SKU
  Next
End Sub
Function GetWebpage(url As String, Optional fileName As String) As String
 
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
 
  Set xml = GetMSXML
 
  ' grab webpage
  With xml
    .Open "GET", url, False
    .send
  End With
 
  GetWebpage = xml.responseText
 
  ' write to file?
  If Len(fileName) > 0 Then
    If Not FileExists(fileName) Then
      Call CreateFile(fileName, GetWebpage)
    Else ' file exists
      If MsgBox("File already exists, overwrite?", vbYesNo) = vbYes Then
        Call CreateFile(fileName, GetWebpage)
      End If
    End If
  End If
 
End Function

Function FileExists(fileName As String) As Boolean
  FileExists = (Len(Dir(fileName)) > 0)
End Function

Function GetMSXML() As Object  '  MSXML2.XMLHTTP60
 On Error Resume Next
  Set GetMSXML = CreateObject("MSXML2.XMLHTTP.6.0")
End Function

Function CreateFile(fileName As String, contents As String) As String
' creates file from string contents
 
Dim tempFile As String
Dim nextFileNum As Long
 
  nextFileNum = FreeFile
  tempFile = fileName
 
  Open tempFile For Output As #nextFileNum
  Print #nextFileNum, contents
  Close #nextFileNum
 
  CreateFile = tempFile
End Function

Select allOpen in new window

Thanks
fordraiders