search for multiple text strings then return assigned value

[DiLaflamme]

Hello everyone. I am new to this, please bear with me. I hope I am phrasing my question well. Thanks for your help in advance!

I have a spreadsheet with hundreds of URLs, and buried somewhere in that URL is a product code. Convention is not the strong suit here, so the code can be anywhere in the URL string. I'm hoping to search for all of the project codes through the URLs, and if found, insert the product name.

Example:

URL	Product name
crzyurl.com/cms/type/core/s/865278/res/600x1024/text/uncompressed/ver/4.0.2/lang/en/fname/assets.zip
crzyurl.com/cms/type/core/pId/5/res/320x480/text/pvr/ver/1.0.39/lang/en/fname/320480_pvr.zip

<tbody>
</tbody>

On a seperate work sheet I have the product code mapping (hundreds of them):

Product ID	Product name
865278	Product 1
320480	Product 2

<tbody>
</tbody>

I would like to search for all of the product IDs in the URLS. When it finds a match, insert the Product Name in the cell next to the URL.

Please tell me this is possible!

 

[JoeMo]

Assuming your list of URLs is in Sheet1 starting in A2 (Header in A1), and your product table (ID/Name) is in Sheet2 starting in A2 (ID) and that no URL will contain more than one Product ID, this will produce a list of Product Names Starting in B2 of Sheet1:

Sub FindProductID()
Dim Prods As Variant, URLs As Variant, vOut As Variant, i As Long, j As Long, ct As Long
'Assume URL list is on sheet1 starting in A2 and product ID/Name table on sheet2 starting in A2
'Assume not more than one product ID found in any URL
Prods = Sheets("Sheet2").Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value
URLs = Sheets("Sheet1").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
ReDim vOut(1 To UBound(URLs, 1), 1 To 1)
For i = 1 To UBound(URLs, 1)
    For j = 1 To UBound(Prods, 1)
        If URLs(i, 1) Like "*" & Prods(j, 1) & "*" Then
            ct = ct + 1
            vOut(i, 1) = Prods(j, 2)
            Exit For
        End If
    Next j
Next i
If ct > 0 Then
    Sheets("Sheet1").Range("B2:B" & UBound(vOut, 1) + 1).Value = vOut
Else
    MsgBox "No Product IDs found in list of URLs"
End If
End Sub