Comparing Ranges - Partial Match VBA or Formula Request

[Teddy.B.Baker]

I need some help on adapting a VBA module. The original module is useful for me when I am looking for exact matches, but now I need to find partial matches. Is this possible? For example in the CompareRange there might be a value of 93472398742398-118 but somewhere within the selection the value is only 93472398742398. The CompareRange is several thousand rows and the selection is much smaller.
I found the original formula here: How to compare data in two columns to find duplicates in Excel.

<code>Sub Find_Matches()
    Dim CompareRange As Variant, x As Variant, y As Variant
    ' Set CompareRange equal to the range to which you will
    ' compare the selection.

    Set CompareRange = Range("F1:F5126")
    ' NOTE: If the compare range is located on another workbook
    ' or worksheet, use the following syntax.
    ' Set CompareRange = Workbooks("Book2"). _ 
    ' Worksheets("Sheet2").Range("F1:F5126")'
    
    ' Loop through each cell in the selection and compare it to
    ' each cell in CompareRange.
    For Each x In Selection 
        For Each y In CompareRange 
            If x = y Then x.Offset(0, 1) = x 
        Next y
    Next x
End Sub

</code>I also tried to adapt a formula that I found in one of the Stack Overflow answers:
Determine if name in list A has perfect match, partial match, or is not found in list B?
but Excel says there's an error in the formula. However, I don't understand what the error is.

<code>=MATCH(FALSE;ISERROR(SEARCH(B1;A1:A100));0)</code>I'm somewhat at a loss now. Thanks for any help. Please note that I am still a novice when it comes to Excel formulas and VBA.

 

[timfritsch]

Something like this might work (untested)...

  For Each x In Selection 
    For Each y In CompareRange 
      If x = y Then x.Offset(0, 1) = x 
    Next y
  Next x

  For Each x In Selection 
    For Each y In CompareRange 
      if instr(1,x,y)>0 then 
        ans = msgbox("Does " & x & " contain "y "?",vbyesno)
        
        if ans = vbyes then x.Offset(0, 1) = x 
      end if
    Next y
  Next x

Displaying the msgbox will allow you to test the new code. If it seems to work correctly, then remove the "ans = "... and "if ans = " and leave the "x = x.offset"...

Hope this helps.


Tim