Excel macro to search multiple urls in one column

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")