Partial match string from a range to another range

Question

I'm trying to return the partial match string on a column right beside the column with the text I'm trying to search within. This is the code I tried to write. What would be a better way to do this?

Essentially I have a column with:

Column 1  
aaaaa1111  
...  
zzzzz9999

Column 2  
aaa  
bbb  
..  
zzz

I want to return column 2 values to the column adjacent to column 1 where the column 2's string can be found within column 1.

Sub match()
Dim ws As Worksheet
Dim vendors As Range
Dim description As Range
Dim match As Range
Dim cell As Range
Dim j As Integer
Dim i As Integer


Set vendors = ws.Range("ae2:ae1007").Text
Set description = ws.Range("o2:o32609")
Set match = ws.Range("p2:p32609")

For i = 2 To 32609
    For j = 2 To 1007
        If InStr(description.Cells(i, "O"), vendors.Range(j, "AE")) > 0 Then
            match.Cells(i, "P") = vendors.Range(j, "AE").Text
        Else: match.Cells(i, "P") = "#N/A"
        End If
    Next j
Next i
        
End Sub

Update: (I get run-time error '91' on line 9)

Sub match()
Dim ws As Worksheet
Dim cell As Range
Dim j As Integer
Dim i As Integer


For i = 2 To 32609
    For j = 2 To 1007
        If InStr(ws.Cells(i, "O"), ws.Cells(j, "AE")) > 0 Then
            ws.Cells(i, "P") = ws.Cells(j, "AE").Text
        Else: ws.Cells(i, "P") = "#N/A"
        End If
    Next j
Next i
        
End Sub

Answer 1

Compare Two Columns

• This is a basic example that loops through column O and compares each value against each value in column AE. Match is no good because the values in AE need to be contained in O. You can always improve efficiency by using arrays as illustrated in Raymond Wu's answer.
• On the other hand, you could loop through column AE and use the Find and FindNext methods to find all matches in column O which might also be more efficient.

Option Explicit

Sub MatchVendors()

    ' s - Source (read from ('vendors'))
    ' d - Destination (read from ('description') and written to ('match'))
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1") ' adjust, often...
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1") ' ... different
    
    Dim slRow As Long: slRow = sws.Range("AE" & sws.Rows.Count).End(xlUp).Row
    If slRow < 2 Then Exit Sub ' no data in source
    Dim srg As Range: Set srg = sws.Range("AE2:AE" & slRow)
    
    Dim dlRow As Long: dlRow = dws.Range("O" & dws.Rows.Count).End(xlUp).Row
    If dlRow < 2 Then Exit Sub ' no data in destination
    Dim drg As Range: Set drg = dws.Range("O2:O" & dlRow)
    
    Application.ScreenUpdating = False
    
    Dim sCell As Range
    Dim dCell As Range
    Dim IsMatch As Boolean
    
    For Each dCell In drg.Cells
        ' Read (Search)
        For Each sCell In srg.Cells
            ' Either 'contains'...
            If InStr(1, dCell.Value, sCell.Value, vbTextCompare) > 0 Then
            ' ... or 'begins with':
            'If InStr(1, dCell.Value, sCell.Value, vbTextCompare) = 1 Then
                IsMatch = True
                Exit For
            End If
        Next sCell
        ' Write
        If IsMatch Then
            dCell.EntireRow.Columns("P").Value = sCell.Value
            IsMatch = False
        Else
            dCell.EntireRow.Columns("P").Value = "#N/A"
        End If
    Next dCell
    
    Application.ScreenUpdating = True
    
    MsgBox "Vendors matched to Descriptions.", vbInformation
        
End Sub