Sorry about caps lock . . .
Here is Code from file:

Code:
Option Explicit
Dim var As Variant

Sub SearchBing()
    
    Dim rng As Range
    Dim lngCol As Long
    Dim oXML As New MSXML2.XMLHTTP
    Dim uTxt As Variant
    Dim xURL As String
    
    Dim srchString As Variant
    Dim StrStart As Variant
    Dim StrEnd As Variant
    Dim StrOutput As Variant
    Dim x As Variant
    Dim OutputRowNumber As Variant
    
    ' Clear Destination Column for URL Lookup
    Worksheets("Sheet1").Range("B2:B" & Rows.Count).ClearContents
    
      
    ' Set base search using bing instead of google because google's pages are a mess
    Const strURL = "http://www.bing.com/search?q=|+|"
    ' Move through source cells
    For Each rng In Worksheets("Sheet1").Range("A2:A5000")
        ' Make sure range is not empty before we start
        If Not IsEmpty(rng) Then
            ' encode url for direct submission
            xURL = Replace(strURL, "|+|", URLEncode(rng.Value))
            'Debug.Print xURL
            ' set object parameters
            oXML.Open "GET", xURL, False
            oXML.setRequestHeader "Content-Type", "text/xml"
            
            ' Delay request by wait to allow catchup and to not freakout
            ' search firewalls
            x = x + 1
            If x = 6 Then
            x = 0
            'Slow it down a bit
            DoEvents
            End If
            'Debug.Print "x=" & x
                       
            ' if you don't have this program will crap out if it encounters weird
            ' formatted page
            On Error Resume Next
            
            'Send request returns page of searchable xml text to oXML object
            oXML.send
            'FIRST SEARCH PRIORITY
            ' srchstring finds unique string in the ballpark of what you want
            ' add more searchs if you want other information or if you want to
            ' get check more accurate info from page if it is available
            ' this section finds "website" button that sometimes appears on the right
            ' of bing search results
            srchString = "role=""button"" href=""http"
            ' extract small chunk of text so you can search again without dupes
            StrStart = InStr(1, oXML.responseText, srchString) + 20
            StrEnd = InStr(StrStart, oXML.responseText, 60)
            StrOutput = Mid(oXML.responseText, StrStart, StrEnd - StrStart - 3) & Chr(10)
            
            ' in the smaller string you extracted above drill down on the actual string
            ' you want - this one finds the first instance of http in the smaller string
            StrStart = InStr(1, StrOutput, "http")
            ' this one finds the end of the url by starting 9 after http and looks for "
            StrEnd = InStr(StrStart + 9, StrOutput, """")
            ' use start and end to isolate the web address
            StrOutput = Mid(StrOutput, StrStart, StrEnd - StrStart)
            
            
            
            'SECOND SEARCH PRIORITY
            ' using if-then If the first search does not find a website button it
            ' returns first item from search results. Note: First result is not always
            ' what you want
            If InStr(1, StrOutput, "www.w3.org") Then
                    srchString = "Search Results"
                    StrStart = InStr(1, oXML.responseText, srchString) + 47
                    StrEnd = InStr(StrStart, oXML.responseText, 60)
                    StrOutput = Mid(oXML.responseText, StrStart, StrEnd - StrStart - 3) & Chr(10)
            
             
                    StrStart = InStr(1, StrOutput, "http")
                    StrEnd = InStr(StrStart + 9, StrOutput, """")
                    StrOutput = Mid(StrOutput, StrStart, StrEnd - StrStart)
                     
            End If
            
            'Remove results that is too long (likely some sort of error)
            If Len(StrOutput) > 50 Then StrOutput = "NOT FOUND"
            
            'Cleanup Some of the Bad Addresses
            If InStr(1, StrOutput, "bloomberg.com") Then StrOutput = "NOT FOUND"
            If InStr(1, StrOutput, "dandb.com") Then StrOutput = "NOT FOUND"
            If InStr(1, StrOutput, "bing.com") Then StrOutput = "NOT FOUND"
            If InStr(1, StrOutput, "wikipedia.org") Then StrOutput = "NOT FOUND"
            If InStr(1, StrOutput, "doubleclick.net") Then StrOutput = "NOT FOUND"
            If InStr(1, StrOutput, "brightscope.com") Then StrOutput = "NOT FOUND"
            If InStr(1, StrOutput, "usnews.com") Then StrOutput = "NOT FOUND"
            If InStr(1, StrOutput, "linkedin.com") Then StrOutput = "NOT FOUND"
            If InStr(1, StrOutput, "usnews.com") Then StrOutput = "NOT FOUND"
            
            
            
            'add row numbers for debugging
            'OutputRowNumber = OutputRowNumber + 1
            'Debug.Print OutputRowNumber & ": " & StrOutput
            'Debug.Print oXML.responseText
            
            rng.Offset(, 1).Value = StrOutput
            
        Else
            Exit For
        End If
    Next rng
    'set debugging row back to zero
    'OutputRowNumber = 0
    Set rng = Nothing
    

End Sub


Function URLEncode(EncodeStr As String) As String
    Dim i As Integer
    Dim erg As String
    
    erg = EncodeStr

    ' *** First replace '%' chr
    erg = Replace(erg, "%", Chr(1))

    ' *** then '+' chr
    erg = Replace(erg, "+", Chr(2))
    
    For i = 0 To 255
        Select Case i
            ' *** Allowed 'regular' characters
            Case 37, 43, 48 To 57, 65 To 90, 97 To 122
            
            Case 1  ' *** Replace original %
                erg = Replace(erg, Chr(i), "%25")
        
            Case 2  ' *** Replace original +
                erg = Replace(erg, Chr(i), "%2B")
                
            Case 32
                erg = Replace(erg, Chr(i), "+")
        
            Case 3 To 15
                erg = Replace(erg, Chr(i), "%0" & Hex(i))
        
            Case Else
                erg = Replace(erg, Chr(i), "%" & Hex(i))
                
        End Select
    Next
    
    URLEncode = erg
    
End Function