Ensure data goes onto a certain SHEET

Sharid

Sharid

Well-known Member
Joined
Apr 22, 2007
Messages
1,064
Office Version
  1. 2016
Platform
  1. Windows
I have a user form, which can remain open on any sheet, when the code below is run it places the data on the active sheet and not on the sheet called "DATA". I have highligted the bit below in red that I this is the issue, could someone please have a look. Many Thanks

Rich (BB code): 
Private Sub CommandButton1_Click()

' UserForm1 Textbox input Data
Worksheets("Keywords").Range("C3") = TextBox1.Text
Worksheets("Keywords").Range("C4") = TextBox2.Text
Worksheets("Keywords").Range("C5") = TextBox3.Text
Worksheets("Keywords").Range("C6") = TextBox4.Text

'Keyword URL SCRAPER
 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
    
    ' Takes seach from Keyword Sheet Cell C3 and places it into google
        url = "https://www.google.co.uk/search?q=" & Replace(Worksheets("Keywords").Range("C3").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

    ' Searches URLS and places them in Sheet called DATA  ROW 2 Column C
    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
        ' Searches Number of Pages entered in Keyword Sheet Cell C4
        If pageNumber >= Replace(Worksheets("Keywords").Range("C4").Value, " ", "+") Then Exit Do
         On Error Resume Next
         Set nextPageElement = HTMLdoc.getElementById("pnnext")
        If nextPageElement Is Nothing Then Exit Do
     
        ' Scrolls Down the Browser
        IE.document.parentWindow.Scroll 0&, 99999
        'Random delay from Max number entered in Keyword sheet C5
         Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Keywords").Range("C5").Value))
        nextPageElement.Click 'next web page
        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop
        'Random delay from Max number entered in Keyword sheet C6
         Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Keywords").Range("C6").Value))
        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
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
maybe this?

VBA Code: 
Private Sub CommandButton1_Click()

' UserForm1 Textbox input Data
Worksheets("Keywords").Range("C3") = TextBox1.Text
Worksheets("Keywords").Range("C4") = TextBox2.Text
Worksheets("Keywords").Range("C5") = TextBox3.Text
Worksheets("Keywords").Range("C6") = TextBox4.Text

'Keyword URL SCRAPER
 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
    
    ' Takes seach from Keyword Sheet Cell C3 and places it into google
        url = "https://www.google.co.uk/search?q=" & Replace(Worksheets("Keywords").Range("C3").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

    ' Searches URLS and places them in Sheet called DATA  ROW 2 Column C
    With Sheets("DATA")
        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
            ' Searches Number of Pages entered in Keyword Sheet Cell C4
            If pageNumber >= Replace(Worksheets("Keywords").Range("C4").Value, " ", "+") Then Exit Do
             On Error Resume Next
             Set nextPageElement = HTMLdoc.getElementById("pnnext")
            If nextPageElement Is Nothing Then Exit Do
        
            ' Scrolls Down the Browser
            IE.document.parentWindow.Scroll 0&, 99999
            'Random delay from Max number entered in Keyword sheet C5
             Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Keywords").Range("C5").Value))
            nextPageElement.Click 'next web page
            Do While IE.Busy Or IE.readyState <> 4
                DoEvents
            Loop
            'Random delay from Max number entered in Keyword sheet C6
             Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Keywords").Range("C6").Value))
            Set HTMLdoc = IE.document
            pageNumber = pageNumber + 1
        Loop
    End With
IE.Quit
    Set IE = Nothing
    Set HTMLdoc = Nothing
    Set nextPageElement = Nothing
    Set div = Nothing
    Set link = Nothing

 MsgBox "All Done"
End Sub
 
Upvote 0
The above did not work, still imports the data on the active sheet and not on the sheet called data
 
Upvote 0
You are referencing the worksheets "Keywords", is that where you want these Replace functions to go? I don't see code that is pasting to an Active Sheet.
 
Upvote 0
Sorry, let me explain how this works. The command buttons are on a userform.


There are several sheets, two of which are called DATA and Keywords.

I put some information on the sheet called Keywords, in all the cells shown in the code.

This information is then used to get the data from the web. I need the data to go into the worksheet called DATA column B row 2 down

Currently, if I am on another sheet, when the code is run, the information is pasted into that sheet, when it should go into the sheet called DATA

As you can see from image, information ahs gone into Sheet1 as this sheet was active, when it should have go into the sheet called DATA
 

Attachments

  • Screenshot001.jpg
    Screenshot001.jpg
    123.9 KB · Views: 3
Last edited:
Upvote 0
I see what you are saying now. See if this works

VBA Code: 
Private Sub CommandButton1_Click()

' UserForm1 Textbox input Data
Worksheets("Keywords").Range("C3") = TextBox1.Text
Worksheets("Keywords").Range("C4") = TextBox2.Text
Worksheets("Keywords").Range("C5") = TextBox3.Text
Worksheets("Keywords").Range("C6") = TextBox4.Text

'Keyword URL SCRAPER
 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
    
    ' Takes seach from Keyword Sheet Cell C3 and places it into google
        url = "https://www.google.co.uk/search?q=" & Replace(Worksheets("Keywords").Range("C3").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

    ' Searches URLS and places them in Sheet called DATA  ROW 2 Column C
    With Sheets("DATA")
        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
            ' Searches Number of Pages entered in Keyword Sheet Cell C4
            If pageNumber >= Replace(Worksheets("Keywords").Range("C4").Value, " ", "+") Then Exit Do
             On Error Resume Next
             Set nextPageElement = HTMLdoc.getElementById("pnnext")
            If nextPageElement Is Nothing Then Exit Do
        
            ' Scrolls Down the Browser
            IE.document.parentWindow.Scroll 0&, 99999
            'Random delay from Max number entered in Keyword sheet C5
             Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Keywords").Range("C5").Value))
            nextPageElement.Click 'next web page
            Do While IE.Busy Or IE.readyState <> 4
                DoEvents
            Loop
            'Random delay from Max number entered in Keyword sheet C6
             Application.Wait Now + TimeSerial(0, 0, Application.RandBetween(1, Worksheets("Keywords").Range("C6").Value))
            Set HTMLdoc = IE.document
            pageNumber = pageNumber + 1
        Loop
    End With
IE.Quit
    Set IE = Nothing
    Set HTMLdoc = Nothing
    Set nextPageElement = Nothing
    Set div = Nothing
    Set link = Nothing

 MsgBox "All Done"
End Sub
 
Upvote 0
Just two things,

1) what did you add/change
2) How do you post code so, it displays in color as your did as mine was in black, as I tried <rich/>
 
Upvote 0
I changed
VBA Code: 
Cells(i, 2).Value = link.getAttribute("href")
to
Code: 
.Cells(i, 2).Value = link.getAttribute("href")

Your code first just did Cells(i, 2).Value which gives you the current sheet. When i added the With Statement, using .Cells will use the Sheet within the With Statement. and if you click two buttons to the right of <rich/> "</>", I paste the code in there.
 
Upvote 0
Sharid said:
2) How do you post code so, it displays in color as your did as mine was in black, as I tried <rich/>
Click to expand...
If you use the <vba/> tags, the code will be coloured automatically, but if you want to highlight part of it (to show where an error is occurring) then you need to use the <rich/> tags
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question
Running through a Config and pulling out the relevant information using keywords into smaller sheets
Replies
0
Views
133
oitbc
O
J
  • Question
Lottery results Belgium
Replies
2
Views
162
jacafate
J
V
  • Solved
Email Body
Replies
9
Views
379
Trixterz
T
O
  • Question
Another problem reading HTML-page
Replies
2
Views
178
Oldfox
O
F
  • Solved
Search Page By Page Instead Of Word by Word
Replies
1
Views
524
fiberboysa
F

Forum statistics

Threads
1,214,915
Messages
6,122,212
Members
449,074
Latest member
cancansova

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top