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?

 

[kleinermuk]

The master list was divided successfully.

When I tried to run macros for collecting URL's, it would not be stopped by Google anymore, however no URL's are collected either.

By the way, your script has your comments in it, marked in green. Do I need to delete those comments before I run macros?

 

[CsJHUN]

No need to delete comment lines, it's up to you.
If you do it manually is the URL's still in 21 and 22 row?
Also if you use on multiple sheets you have to change: these parts

co_name = Sheets(1).Range("A" & company_count).Value
....
exit_cell_loop:
Sheets(1).Range("b" & company_count).Value = Sheets(Sheets.Count).Range("A" & www_row).Value
Sheets(1).Range("C" & company_count).Value = Sheets(Sheets.Count).Range("A" & www_row + 1).Value

to this

co_name = Range("A" & company_count).Value
...
exit_cell_loop:
Range("b" & company_count).Value = Sheets(Sheets.Count).Range("A" & www_row).Value
Range("C" & company_count).Value = Sheets(Sheets.Count).Range("A" & www_row + 1).Value

First version made for works on first sheet. If you run on different sheets it will still run on the 1st sheet.
"Sheet(1)." could also replaced to "Activesheet"

 

[kleinermuk]

sorry, can you please put the full macros for multiple sheets, so I just copy paste?

 

[CsJHUN]

you have to run the code below on every sheet one-by-one

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

Dim co_name As String
sht_asheet_index = ActiveSheet.Index

lra = Sheets(sht_asheet_index).Range("a" & Rows.Count).End(3).Row
For company_count = 2 To lra
co_name = Sheets(sht_asheet_index).Range("A" & company_count).Value
Sheets.Add after:=Sheets(Sheets.Count)
On Error Resume Next
querry_add co_name
On Error GoTo -1
find_www_in_a company_count, sht_asheet_index
Sheets(Sheets.Count).Delete
Application.Wait (Now + #12:00:01 AM#)
Next company_count

End Sub


Private Sub querry_add(co_name As String)
search_link = "URL;https://www.google.com/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


Private Sub find_www_in_a(company_count, sht_asheet_index)

For Each cell In Range("A20:A70")
If Left(Trim(cell.Value), 3) = "www" Then www_row = cell.Row: GoTo exit_cell_loop
Next cell
Exit Sub

exit_cell_loop:
Sheets(sht_asheet_index).Range("b" & company_count).Value = Sheets(Sheets.Count).Range("A" & www_row).Value
Sheets(sht_asheet_index).Range("C" & company_count).Value = Sheets(Sheets.Count).Range("A" & www_row + 1).Value

End Sub

I suggest make icon on quick access toolbar which call this

OR assign a key combination (Open "macro" window, select the macro, click on options, set key, save)
Then you don't need to start it from VBE (alt+F11)

 

[kleinermuk]

It seems like working except that for some reason it start with raw 2 instead of raw 1.

 

[CsJHUN]

Oh yeah, by kin for headlines... :D

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

Dim co_name As String
sht_asheet_index = ActiveSheet.Index

lra = Sheets(sht_asheet_index).Range("a" & Rows.Count).End(3).Row
For company_count = 1 To lra 'Changed this row from "For company_count = " To lra"
co_name = Sheets(sht_asheet_index).Range("A" & company_count).Value
Sheets.Add after:=Sheets(Sheets.Count)
On Error Resume Next
querry_add co_name
On Error GoTo -1
find_www_in_a company_count, sht_asheet_index
Sheets(Sheets.Count).Delete
Application.Wait (Now + #12:00:01 AM#)
Next company_count

End Sub


Private Sub querry_add(co_name As String)
search_link = "URL;https://www.google.com/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


Private Sub find_www_in_a(company_count, sht_asheet_index)

For Each cell In Range("A20:A70")
If Left(Trim(cell.Value), 3) = "www" Then www_row = cell.Row: GoTo exit_cell_loop
Next cell
Exit Sub

exit_cell_loop:
Sheets(sht_asheet_index).Range("b" & company_count).Value = Sheets(Sheets.Count).Range("A" & www_row).Value
Sheets(sht_asheet_index).Range("C" & company_count).Value = Sheets(Sheets.Count).Range("A" & www_row + 1).Value

End Sub

 

[kleinermuk]

I think it worked in the end, so I appreciate all your help.

As now I have 693 sheets and almost each of them containing a phone number, I will publish a new post asking for a help in retrieving those numbers. If you know how, please advise under that new post. Thx