Extract data from excel for input loop in VBA scraping

Question

I am a complete novice in VBA and I'm in way over my head I think but the research necessitates it. I followed a great online tutorial series, which unfortunately didn't help me in solving 1 big problem: Data input.

My goal is to scrape patent data from google patents. To do so, it's pretty convenient that Google patents website is uniquely identified by the patent number. Thus what I want to achieve is the following:

Extract the patent number from a list in excel
Use that number to access the specific webpage
Extract application and publication year of patent, as well as patent number (as check)
Store all in a single excel sheet

Now, I can make 2,3, and 4 work but it's the loop that allows me to extract the patent numbers from excel and put them into my code that I am missing.

Here is the current code:

 Private Sub CommandButton4_Click()
Dim obMF As Object

Dim patent As String
Dim grant_date As String
Dim app_date As String
Dim patent_number As String
    patent_number = insert.Text ' insert.Text refers to a textbox in my interface


Call gotopat(patent_number, patent, app_date, grant_date)

found.Text = patent
grantdate.Text = grant_date
appdate.Text = app_date

output_row = 1 'Set the output row as 1 (this is where the title is)
Do
DoEvents
output_row = output_row + 1 'Increase output row with 1

Loop Until Sheets("bkcit").Range("B" & output_row) = ""
    'Continue loop until that cell ~ Range is blank.
    'Once a blank is found, we can put new data in there

'Store data into Worksheet "bkcit"

    Sheets("bkcit").Range("B" & output_row) = patent
    Sheets("bkcit").Range("C" & output_row) = grant_date
    Sheets("bkcit").Range("D" & output_row) = app_date

In this code, found.Text, grantdate.Text, and appdate.Text are sourced from the scraping function which works perfectly. The important things about that function are:

Function gotopat(patent_number As String, patent As String, app_date As String, grant_date As String)
' A Bunch of other stuff
obMF.Navigate ("http://www.google.com/patents/US" & patent_number & "?")
'All the scraping code'

So, I want to replace the patent_number = insert.Text by a loop that looks in my excel sheet bkcit, column A and basically loops through all the unique patent numbers. I tried

input_row = 1
 Do
 DoEvents
 input_row = input_row + 1
 Range("C" & input_row) = patent_number
 Loop Until Sheets("bkcit").Range("A" & input_row) = ""

But this seems to delete the first patent number in cell A2 and nothing more.

I'm thinking I'm pretty close to a working solution but your help would be fantastic, as always!

Thanks in advance

Simon

Automate This · Accepted Answer · 2014-05-22 21:54:40Z

1

If I understand correctly, you have a column of patent numbers like this:

enter image description here

And you want to loop through each number and do something to it. Try this:

Sub loopPatents()
    Dim patentNumber As Range
    Dim patentRange As Range
    Set patentRange = Worksheets(1).Range("A2:A10")

    For Each patentNumber In patentRange
        MsgBox ("Patent number: " & patentNumber)

        'Do your stuff with the patent number here

    Next patentNumber
End Sub

edited May 22, 2014 at 21:54

answered May 22, 2014 at 21:29

Automate This

31.5k11 gold badges63 silver badges85 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

Jzz Over a year ago

you forgot to declare patentNumber

SJDS Over a year ago

Hi man, I found a simple workaround that does the trick but I face a run time error after 74 iterations: run time error '-2147467259 (80004005)' Will try with @PortlandRunner's suggestion and see if problem is the same

Automate This Over a year ago

Might be a limit on the number of queries Google allows if you don't have a paid account.

SJDS Over a year ago

Yeah, I was fearing it would be something like that. I'm trying your solution but I get an Error about the location of the End Sub. I basically inserted your code (changing patentNumber for patent_Number) just before the Call gotopatent... and added the End Sub where I ended my input row loop but I have two Subs now and that seems to fail...

Automate This Over a year ago

Put Next patent_number at the end of the loop and don't use End Sub since you already have one at the end of Private Sub CommandButton4_Click() code block.

Collectives™ on Stack Overflow

Extract data from excel for input loop in VBA scraping

1 Answer 1

5 Comments

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Related