VBA EXCEL GOOGLE LOOKUP

Question

I found some VBA excel code that allowed the range of key words to be looked up on google and returned the first link. I want to add an input box in the beginning to say get the top 5 links. I have 2000 key words that i need to search on google and return the top few links. Can someone please help me expand this code in order to do that???? Thank you so much!

Here is the code provided by another stackoverflow user:

Sub XMLHTTP()

Dim url As String, lastRow As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
Dim start_time As Date
Dim end_time As Date

lastRow = Range("A" & Rows.Count).End(xlUp).Row

Dim cookie As String
Dim result_cookie As String

start_time = Time
Debug.Print "start_time:" & start_time

For i = 2 To lastRow

    url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
    XMLHTTP.send

        Set html = CreateObject("htmlfile")
    html.body.innerHTML = XMLHTTP.ResponseText
    Set objResultDiv = html.getelementbyid("rso")
    Set objH3 = objResultDiv.getelementsbytagname("H3")(0)
    Set link = objH3.getelementsbytagname("a")(0)


    str_text = Replace(link.innerHTML, "<EM>", "")
    str_text = Replace(str_text, "</EM>", "")

    Cells(i, 2) = str_text
    Cells(i, 3) = link.href
    DoEvents
Next

end_time = Time
Debug.Print "end_time:" & end_time

Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub

Column A was the keywords, Column B was the link Name, C was the link. I want to keep that format but add a few more lined between each keyword. Meaning that if A1 has the keyword "hello" then B1 would be first link name and C1 is link. B2 would be next link name and C2 next link, B3 next ....etc. Also if my list has A1 with "hello" and A2 with "hawaii" then my A2 cell would be pushed down to A6 after the 5 new names and links.

Thank you all for your help in advance. You would really be saving me!

You should set a break point at the start of the code and step through it. Look for the lines that are adding data to the sheet. Try to understand and then decipher what those lines are doing. Once you have that down, make a change to the code that seems intuitive from what you learned. Re-run the code and see if you're getting the expected results (or at least different results). Rinse and repeat until you get your desired output. At the very least, make an attempt to understand the problem and try a solution before asking for help. That's the best advice I can give. — sous2817
– sous2817, Commented Jul 18, 2014 at 16:13
I appreciate it very much. I have tried multiple times and failed. I have gotten the input box idea on my first go ahead but its just looped my back to the first link. I was unable to move down the list. I have succeeded in the inputbox and moving the remaining key words done but my sheet put out 5 lines of the same link. — acoopie89
– acoopie89, Commented Jul 18, 2014 at 16:21
Ok, it may be better to break your question down in to parts and try and solve them in sections rather than posting a wall of code and ask people to do it for you. You'll get a much better answer rate of "I need to do {X}, I tried {Y}, it fails at point {Z}, with error message {Blah}". — sous2817
– sous2817, Commented Jul 18, 2014 at 16:34

klib · Accepted Answer · 2014-07-18 17:15:43Z

You asked a lot of different questions but to answer what I perceive as the main problem, this line:

Set objH3 = objResultDiv.getelementsbytagname("H3")(0)

is what controls what link the code is looking at. So by changing the 0 to 1 it will now process the second link. By writing a simple for loop you can process the top five links. I would suggest reformatting your data first to leave enough spaces to fill in with the five entries and then use a simple for loop approach such as which does work but may take awhile for 1000 terms (also I switched it to start at A1 like you said):

Sub XMLHTTP()
Dim url As String, lastRow As Long
Dim XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object
Dim start_time As Date
Dim end_time As Date

lastRow = Range("A" & Rows.Count).End(xlUp).Row

Dim cookie As String
Dim result_cookie As String
Dim Z As Long
Dim Y As Long
Z = lastRow
Y = 2
'adds the blank rows for all 5 results
While Y <= Z
    Rows(Y & ":" & Y).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Y = Y + 5
    Z = Z + 4
Wend
lastRow = (lastRow - 1) * 4 + lastRow
start_time = Time
Debug.Print "start_time:" & start_time
'starts at A1
For i = 1 To lastRow

    url = "https://www.google.co.in/search?q=" & Cells(i, 1) & "&rnd=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
    XMLHTTP.send

    Set html = CreateObject("htmlfile")
    html.body.innerHTML = XMLHTTP.ResponseText
    Set objResultDiv = html.getelementbyid("rso")

    'loops through the first 5 results
    For g = 0 To 4

        Set objH3 = objResultDiv.getelementsbytagname("H3")(g)
        Set link = objH3.getelementsbytagname("a")(0)


        str_text = Replace(link.innerHTML, "<EM>", "")
        str_text = Replace(str_text, "</EM>", "")

        Cells((i + g), 2) = str_text
        Cells((i + g), 3) = link.href
        DoEvents
    Next
    i = i + 4
Next

end_time = Time
Debug.Print "end_time:" & end_time

Debug.Print "done" & "Time taken : " & DateDiff("n", start_time, end_time)
MsgBox "done" & "Time taken : " & DateDiff("n", start_time, end_time)
End Sub

Also your code starts at A2 not A1 as you indicated in your question, you will need to change the "For i = 2 To lastRow" to "For i = 1 To lastRow" if you want it to start at A1
Thank you so much. I couldnt figure out that line was the code for the internet location. Its now done and working with a loop. Thank you!

Collectives™ on Stack Overflow

VBA EXCEL GOOGLE LOOKUP

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related