Web Scrape "Name" from webpage based on URL in Column A

Hello Brawnystaff,

I have added two macros to the attached workbook which is the original you post. There is button to run the macros. It will list all the names as they appear on the web page.

Here are the macro that have been added...

Get the HTML Document from a URL

' Written: December 31, 2013
' Author:  Leith Ross
' Summary: Returns the HTML DOM from a given URL.

Function GetHTMLdocument(ByVal URL As String) As Object
        
    Dim HTMLdoc     As Object
    Dim PageSrc     As String
      
      
      ' Retrieve the web page's HTML code (page source) from the server.
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, True
            .Send
        
            While .readyState <> 4: DoEvents: Wend
        
          ' Check for any connection errors.
            If .statusText <> "OK" Then
                MsgBox "ERROR: " & .Status & " - " & .statusText, vbExclamation
                Exit Function
            End If
        
            PageSrc = .ResponseText
        End With
            
      ' Create an empty HTML Document.
        Set HTMLdoc = CreateObject("htmlfile")
        
      ' Convert the Page Source into an HTML document.
        HTMLdoc.body.innerHTML = PageSrc
        
      ' Close the HTML file.
        HTMLdoc.Close
        
      ' Return the HTML Document Object.
        Set GetHTMLdocument = HTMLdoc
        
End Function

List the Provider Names

' Thread:  http://www.excelforum.com/excel-programming-vba-macros/980331-web-scrape-name-from-webpage-based-on-url-in-column-a.html
' Poster:  Brawnystaff
' Written: January 10, 2014
' Author:  Leith Ross

Sub ListProviderNames()

    Dim Cell As Range
    Dim HTMLdoc As Object
    Dim ProviderName As String
    Dim Rng As Range
    Dim RngEnd As Range
    Dim oTable As Object
    Dim Wks As Worksheet
    
        
        Set Wks = Sheet1
        Set Rng = Wks.Range("A2")
        
          ' Exit if there are no URLs.
            Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
            If RngEnd.Row < Rng.Row Then Exit Sub
            
          ' Size the range of URLs.
            Set Rng = Rng.Resize(RngEnd.Row - Rng.Row + 1, 1)
            
          ' Clear any previous names.
            Rng.Offset(0, 1).ClearContents
            
          ' Get the provider name from each URL.
            For Each Cell In Rng
                Set HTMLdoc = GetHTMLdocument(Cell.Value)
                
                On Error Resume Next
                
                  ' Search all the tables for a cell labeled "Name:".
                    For Each oTable In HTMLdoc.getelementsbytagname("table")
                        ProviderName = oTable.Rows(0).Cells(1).ChildNodes(0).innerHTML
                        
                      ' No error if there is a match.
                        If Err = 0 Then
                            If Left(ProviderName, 5) = "Name:" Then
                              ' Get the provider name.
                                ProviderName = oTable.Rows(0).Cells(2).innerHTML
                                Exit For
                            End If
                        End If
                        
                        Err.Clear
                        ProviderName = ""
                    Next oTable
                    
                On Error GoTo 0
                Cell.Offset(0, 1).Value = ProviderName
            Next Cell
            
      ' Listing is complete.
        MsgBox "All Names have been Listed."
        
End Sub

Hello Brawnystaff,

You're welcome. Glad I could help out.