Excel macro to search multiple urls in one column - vba

Question

I have a worksheet (Sheet2) that contains 27 columns, first row is the columns headers which are A-Z and NUM totaling 27 cols. Each column has a very long list of restricted urls sorted to the letter of the column, and the last (27th) column is for urls that start with a number. The columns' length is between 300-600 thousand cells.
What I have been looking for was a macro script that will examine all newly added urls in col A Sheet1, to find out whether they exist in Sheet2, resulting in flagging each url with "already exist" or "to be added", something like:
Sheet1
Col(A) Col(B)
badsite1.com already exist
badsite2.com already exist
badsite3.com to be added
badsite4.con to be added
badsite5.com already exist
Accordingly "to be added" urls will be added to Sheet2 after running another test online for that url.
Amazingly, I found the following script (missed its source) that does exactly what I'm after applying some minor modifications:
Sub x()
Dim rFind As Range, sFind As Range, sAddr As String, ws As Worksheet, rng As Range, ms As Worksheet
Application.ScreenUpdating = 0
Set ws = Sheets("Sheet2")
Set ms = Sheets("Sheet1")
ms.Range("B2:B" & Rows.Count).ClearContents
Set rng = ms.Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each sFind In rng
With ws.UsedRange
Set rFind = .Find(sFind, .Cells(.Cells.Count), xlValues, xlPart)
If Not rFind Is Nothing Then
sAddr = rFind.Address
Do
sFind.Offset(, 1) = rFind.Address
sFind.Font.Color = -16776961
Set rFind = .FindNext(rFind)
Loop While rFind.Address <> sAddr
sAddr = ""
Else
sFind.Offset(, 1) = "No Found"
sFind.Offset(, 1).Font.Color = -16776961
End If
End With
Next
Set ms = Nothing
Set ws = Nothing
Set rng = Nothing
Set rFind = Nothing
Application.ScreenUpdating = True
End Sub
Running this script is fantastic with a small list of urls (e.g 5-10). With a longer list in Sheet1 col-A and HUGE lists in Sheet2 like mine, this script is a "tortoise", and it took over one hour to examine a list of 167 urls!!
Can this script be modified to be a "rabbit"? :)
Highly appreciating any offered assistance in this regard.
As usual.. thanks in advance.

Answer 1

Try this - Tested in Excel 2010:
Sub x()
Dim rFind As Range, sFind As Range, sAddr As String, ws As Worksheet
Dim rng As Range, ms As Worksheet, s As String
Application.ScreenUpdating = False
'stop calculation
Application.Calculation = xlCalculationManual
Set ws = Sheets("Sheet2")
Set ms = Sheets("Sheet1")
ms.Range("B2:B" & ms.Rows.Count).ClearContents
ms.Range("A2:B" & ms.Rows.Count).Font.Color = 0
Set rng = ms.Range("A2:A" & ms.Cells(ms.Rows.Count, 1).End(xlUp).Row)
For Each sFind In rng
'get first character of url
s = Left(sFind, 1)
'resort to column aa if not a a to z
If Asc(UCase(s)) < 65 Or Asc(UCase(s)) > 90 Then s = "AA"
'only look in appropriate column
Set rFind = ws.Columns(s).Find(sFind, , xlValues, xlPart, xlByRows, xlPrevious)
If Not rFind Is Nothing Then
'only look once and save that cell ref
sFind.Offset(, 1) = rFind.Address
sFind.Font.Color = -16776961
Else
'if not found put default string
sFind.Offset(, 1) = "No Found"
sFind.Offset(, 1).Font.Color = -16776961
End If
Next
Set ms = Nothing
Set ws = Nothing
Set rng = Nothing
Set rFind = Nothing
'enable calculation
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Non VBA - Tested on Excel 2010:
=IFERROR(VLOOKUP(A2, INDIRECT("Sheet2!" & IF(OR(CODE(UPPER(LEFT(A2, 1)))<65,
CODE(UPPER(LEFT(A2, 1)))>90), "AA:AA", LEFT(A2, 1)&":"& LEFT(A2, 1))), 1, FALSE),
"Not Found")