I'm just a beginner with VBA and I'm trying to return the partial match string on a column right beside the column with the full 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: (It still doesn't run - I keep getting 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

CodePudding user response：

You are getting error 91 because you declared ws but did not set ws to any worksheet.

The code below should run pretty fast since it process the data in an array (read/write from cells is a very slow process).

Option Explicit

Sub FindMatch()
    Const vendorCol As String = "AE"
    Const descCol As String = "O"
    Const matchCol As String = "P"
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'Change name accordingly
                
    '==== Get a list of unique vendor names
    Dim vendorDict As Object
    Set vendorDict = CreateObject("Scripting.Dictionary")
    vendorDict.CompareMode = vbTextCompare

    Dim vendorLastRow As Long
    Dim vendorInput As Variant
    
    'Assign the values of the vendor names to array
    vendorLastRow = ws.Cells(ws.Rows.Count, vendorCol).End(xlUp).Row
    vendorInput = ws.Range(ws.Cells(2, vendorCol), ws.Cells(vendorLastRow, vendorCol)).Value
    
    'Loop through the array and add to dictionary if it's not already in it
    Dim n As Long
    For n = 1 To UBound(vendorInput, 1)
        If Not vendorDict.Exists(vendorInput(n, 1)) Then vendorDict.Add vendorInput(n, 1), 1
    Next n
        
    Dim vendorArr As Variant
    vendorArr = vendorDict.keys
    Set vendorDict = Nothing
    Erase vendorInput
    '====
    
    'Assign the values of description to array
    Dim descLastRow As Long
    Dim descArr As Variant
        
    descLastRow = ws.Cells(ws.Rows.Count, descCol).End(xlUp).Row
    descArr = ws.Range(ws.Cells(2, descCol), ws.Cells(descLastRow, descCol)).Value
    
    'Create an array of the same size as the description for match result, will be used to write in to the worksheet once at the end
    Dim matchArr() As Variant
    ReDim matchArr(1 To UBound(descArr, 1), 1 To 1) As Variant
    
    'Loop through the description array and within the loop, check if there's a match in the vendor array
    Dim i As Long
    For i = 1 To UBound(descArr, 1)
        For n = 0 To UBound(vendorArr)
            If InStr(1, descArr(i, 1), vendorArr(n), vbTextCompare) <> 0 Then
                'If match found, assign the vendor name to the match array
                matchArr(i, 1) = vendorArr(n)
                Exit For
            End If
        Next n
        
        'If no match, return NA error
        If matchArr(i, 1) = vbNullString Then matchArr(i, 1) = CVErr(xlErrNA)
    Next i
    
    ws.Cells(2, matchCol).Resize(UBound(matchArr, 1)).Value = matchArr
    
    Erase descArr
    Erase matchArr
End Sub

CodePudding user response：

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