New macros needed

[kleinermuk]

I have a list of companies, so I am wondering a macros can be created where a name of each company is taken one by one and opened in a new Google search page/tab?

 

[CsJHUN]

Hi,

for me its work seamlessly:

Sub kleinermuk()
'https://www.mrexcel.com/board/threads/new-macros-needed.1150242/
lra = Range("A" & Rows.Count).End(3).Row

For Each cell In Range("A2:A" & lra)
ThisWorkbook.FollowHyperlink ("https://www.google.com/search?q=" & cell.Value)
Next cell

End Sub

Assuming you have the company names in column A and it has a header
Win10Pro, Firefox default settings

 

[kleinermuk]

it works great- thx!

But I am wondering if this macros can be improved.

When multiple Google search pages/tabs are opened, Google shows phone number for each company on the right side of its page in a format "Phone: (555) 555-5555". Can that number be returned back to Excel spreadsheet in the column B next to the same business?

Also, Google shows button Website for each company and if you hover over that button, URL address is shown. Can that address be returned to column C?

 

[CsJHUN]

I tried with excel data from website, its a no go, google results shown as one table, and the right side (with company infos) are burried with somewhere the whole table.

edit: tried with yahoo, ask and bing.... all failed

 

[kleinermuk]

can you upload the file here, so I can see how it looks after you import Google page into Excel?

 

[CsJHUN]

can you upload the file here, so I can see how it looks after you import Google page into Excel?

You can do it by your own.
Start excel with empty sheet. Go to data ribbon, there has to be something like "From website"; google the desired company name in the window just opened, click on the top left yellow-orange mark, then import.

 

[kleinermuk]

Ok, I think I see what you saw. I run 3 companies names by the way of ribbons shown on your picture and every time phone number ended up being in a different field pf excel spreadsheet after import.

Yet, the website address is ALWAYS ended up in fields A21 and A22, so I think macros can be written to withdraw address from that field(s).

The test list I used had 3 records:
magnotta winery
inniskillin winery
Two Sisters Vineyards

As for the phone, I see that you are in Hungary, so I am not sure in what format the phone field is shown to you, but for me it is shown in format (555) 555-5555. Can a macros be written, so whenever it sees (..) ...-.... it records it, too?

 

[CsJHUN]

Hi,
used column "A" to filled with company name and the code below resulted this.

Munkafüzet1
	A	B	C
1	Company name	website A21	Website A22
2	magnotta winery	www.magnotta.com	www.magnotta.com
3	inniskillin winery	en.wikipedia.org › wiki › Inniskillin	en.wikipedia.org › wiki › Inniskillin
4	Two Sisters Vineyards	www.twosistersvineyards.com	www.twosistersvineyards.com
Munka1

I used A25 and A26 not for 21 and 22
This is in ONE module

Sub kleinermuk_20201110()
'https://www.mrexcel.com/board/threads/new-macros-needed.115024

Dim co_name As String
lra = Range("a" & Rows.Count).End(3).Row

For company_count = 2 To lra
co_name = Sheets(1).Range("A" & company_count).Value

Sheets.Add after:=Sheets(Sheets.Count)
querry_add co_name
Sheets(1).Range("b" & company_count).Value = Sheets(Sheets.Count).Range("A21").Value
Sheets(1).Range("C" & company_count).Value = Sheets(Sheets.Count).Range("A22").Value
Sheets(Sheets.Count).Delete

Next company_count

End Sub
Sub querry_add(co_name As String)
search_link = "URL;https://www.google.hu/search?q=""" & co_name & """"
'bounch of the below with part is not necessary, but i let it there
    With ActiveSheet.QueryTables.Add(Connection:=search_link, Destination:=Range("$A$1"))
        .Name = "search?q=""magnotta winery""#spf=1604993071782"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

 

[kleinermuk]

I tried to run the new macros. It started by opening multiple sheets in Excel- one sheet for each company, I guess how it was intended. And URL was correctly shown in A21 and A22 of each sheet.

That was a good news.

However, the attached message would pop up and stop macros from running unless I click on either of 2 buttons.

Also, no URL was taken from A21 or A22 and imported into the main sheet next to each company name.

And also, is it possible to close all those extra sheets automatically after A21or A22 were imported from them?

 

[CsJHUN]

hmmm, the macro should delete the page before start a new 'querry'. My theory thats 124.... is the missing site address, so that site is give you some slow response (maybe google server protection). I would try this modification in the first macro, the rest is same:

Sub kleinermuk_20201110()
'https://www.mrexcel.com/board/threads/new-macros-needed.115024

Dim co_name As String
lra = Range("a" & Rows.Count).End(3).Row

For company_count = 2 To lra
co_name = Sheets(1).Range("A" & company_count).Value

Sheets.Add after:=Sheets(Sheets.Count) 'this should create a new worksheet for new querry
querry_add co_name


'####################################
Application.wait(now + #00:00:01#) 'this will make the macro stop for a second after each querry. You can also delete the empty and ### lines, just cannot make it more obvious :D
'####################################


Sheets(1).Range("b" & company_count).Value = Sheets(Sheets.Count).Range("A21").Value
Sheets(1).Range("C" & company_count).Value = Sheets(Sheets.Count).Range("A22").Value
Sheets(Sheets.Count).Delete 'this should delete the last worksheet

Next company_count