Notes

Sub WTE()
Dim catchedUrl(4) As String
Dim i As Long, v As Long, h As Long
Dim ACN As Long, ARN As Long, lastrownumber As Long
Dim ie(4) As InternetExplorer
Dim HTMLDoc As HTMLDocument
Dim HTMLDoc1 As HTMLDocument
Dim Chk As String
Dim sURL(4) As String, Domiz(4) As String

For v = 0 To 4
Set ie(v) = CreateObject("InternetExplorer.application")
ie(v).Visible = True
Next v

With ActiveSheet

ACN = ActiveCell.Column
ARN = ActiveCell.Row
lastrownumber = Cells(Rows.Count, ACN).End(xlUp).Row

For i = ARN To lastrownumber
For v = 0 To 4
sURL(v) = Range("A" & (i + v)).Value
Domiz(v) = Range("E" & (i + v)).Value
ie(v).navigate sURL(v)
Next v

For v = 0 To 4
On Error GoTo Err_Clear
Do
Loop Until ie(v).readyState = READYSTATE_COMPLETE
Set HTMLDoc = ie(v).document

For Each QHE In HTMLDoc.getElementsByTagName("div")
If QHE.className = "b_attribution" Then
CJ = QHE.parentElement.PreviousSibling.FirstChild.href
If InStr(CJ, "buzzfile.com/business") Then
Range("B" & (i + v)).Value = CJ
Range("B" & (i + v)).CurrentRegion.WrapText = False


part = QHE.getAttribute("u")
parts = Split(part, "|")
catchedUrl(v) = "http://cc.bingj.com/cache.aspx?q=" & Range("I" & (i + v)).Value & "&d=" & parts(2) & _
"&mkt=en-IN&setlang=en-US&w=" & parts(3)
Exit For
End If
End If
Next QHE


Set CJ = Nothing
Set QHE = Nothing
Set pHTML_Element = Nothing
Set HTMLDoc = Nothing


Next v

For v = 0 To 4
ie(v).navigate catchedUrl(v)
Next v

Application.Wait (Now + TimeValue("0:00:15"))

For v = 0 To 4

Set HTMLDoc1 = ie(v).document
For Each WEBTD In HTMLDoc1.getElementsByTagName("td")
If InStr(WEBTD.innerText, "Website:") Then
Range("D" & (i + v)).Value = WEBTD.NextSibling.innerText
If (WEBTD.NextSibling.innerText = "") Then

Debug.Print WEBTD.NextSibling.innerText
Range("C" & (i + v)).Value = "No website"
Range("C" & (i + v)).CurrentRegion.WrapText = False
ElseIf InStr(WEBTD.NextSibling.innerText, Domiz(v)) Then
Set oHTML_Element = HTMLDoc1.getElementsByTagName("td")(41)
Range("C" & (i + v)).Value = oHTML_Element.innerText
Range("C" & (i + v)).CurrentRegion.WrapText = False
Range("F" & (i + v)).Value = HTMLDoc1.getElementsByTagName("td")(39).innerText
Range("F" & (i + v)).CurrentRegion.WrapText = False
Range("G" & (i + v)).Value = HTMLDoc1.getElementsByTagName("td")(37).innerText
Range("G" & (i + v)).CurrentRegion.WrapText = False
Range("H" & (i + v)).Value = HTMLDoc1.getElementsByTagName("td")(35).innerText
Range("H" & (i + v)).CurrentRegion.WrapText = False
Exit For
End If
End If
Next WEBTD

Set WEBTD = Nothing
Set oHTML_Element = Nothing
Set HTMLDoc1 = Nothing

Err_Clear:
If Err <> 0 Then
Err.Clear
Resume Next
End If
Next v
i = i + 4
Next i

End With

For v = 0 To 4
Set ie(v) = Nothing
ie(v).Quit
Next v

End Sub

'E1 = Domain
'I1 = buzzfile+"companyDomain"