Help update this Google search code

[Sharid]

Hi

For the first part my code works fine, it does what it is meant to do.

1) I place a search item in Sheet2 Cell A1 e.g. "Laptops" and it opens Google and extracts all the url for laptops
2) It paginates to the next page, for which I have set to 5 pages, so URL from all 5 pages are extracted.
3) It places all the found urls in to Sheet1

All this is fine and does not need fixing.

What I am stuck on and what I need it to do.

Currently I can only place 1 search keyword at a time, I need the code to run of a list from Sheet2 Column A down to the last row with data in it.

[TABLE="class: grid, width: 500"]
[TR]
[TD="align: center"]Column A
[/TD]
[TD="align: center"]Column B
[/TD]
[/TR]
[TR]
[TD]Laptops
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mobile Phones
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mobile Chargers
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Music Mixer
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Laptop screens
[/TD]
[TD][/TD]
[/TR]
[/TABLE]

So the first item "Laptops" is searched for X amount of pages (Currently 5 pages) and then it moves onto the next item in the list and does the same, extracting the urls each time.

Sub webpage()

    Dim ie As Object
    Dim htmlDoc As Object
    Dim nextPageElement As Object
    Dim div As Object
    Dim link As Object
    Dim url As String
    Dim pageNumber As Long
    Dim i As Long
   [COLOR=#008000] 
    ' Takes seach from A1 and places it into google[/COLOR]
    url = "https://www.google.co.uk/search?q=" & Replace(Worksheets("Sheet2").Range("A1").Value, " ", "+")


    Set ie = CreateObject("InternetExplorer.Application")
    
    With ie
        .Visible = True
        .navigate url
        Do While .Busy Or .readyState <> 4
            DoEvents
        Loop
    End With

    Application.Wait Now + TimeSerial(0, 0, 5)
    
    Set htmlDoc = ie.document


    pageNumber = 1
    i = 2
    Do
        For Each div In htmlDoc.getElementsByTagName("div")
            If div.getAttribute("class") = "r" Then
                Set link = div.getElementsByTagName("a")(0)
                Cells(i, 2).Value = link.getAttribute("href")
                i = i + 1
            End If
        Next div
        If pageNumber >= 5 Then Exit Do[COLOR=#008000] 'The first 5 pages[/COLOR]
        Set nextPageElement = htmlDoc.getElementById("pnnext")
        If nextPageElement Is Nothing Then Exit Do
        
       [COLOR=#008000] ' Clicks web next page[/COLOR]
        nextPageElement.Click 'next web page
        Do While ie.Busy Or ie.readyState <> 4
            DoEvents
        Loop
        Application.Wait Now + TimeSerial(0, 0, 5)
        Set htmlDoc = ie.document
        pageNumber = pageNumber + 1
    Loop

   
ie.Quit
    Set ie = Nothing
    Set htmlDoc = Nothing
    Set nextPageElement = Nothing
    Set div = Nothing
    Set link = Nothing

 MsgBox "All Done"

End Sub

Thanks for having a look

 

[ismii]

Psuedocode would be something like

dim counter as long

for counter = startingrow to getLastRow
   'do what you need to for each search
next counter

Then a working function for lastrow:

Function getLastRow(Optional columnNumber As Long = 1, _
                    Optional wksht As Worksheet) As Long
    If wksht Is Nothing Then Set wksht = ActiveSheet
    getLastRow = wksht.Cells(wksht.Rows.Count, columnNumber).End(xlUp).Row
End Function