# Finding similar strings within two cells in excel

I want to extract similar strings within two cells as an Excel function. See below example:

I read some pages like it but doesn't help me.

• What have you tried so far?
– dmb
Sep 4, 2021 at 0:23

You can try this code:

``````Option Base 1
Sub CompareStrings2()
Application.ScreenUpdating = False
If Selection.Columns.Count <> 2 Then GoTo MyExitSub
Dim i As Long, lenC1 As Long, lenC2 As Long, r As Long, y As Long, x As Long, ChkLen As Long, OffSetCol As Long
Dim C1Str As String, C2Str As String, tempStr As String
Dim ArrC1(), ArrC2, ArrSel, ArrResult
ArrSel = Selection
i = UBound(ArrSel, 1)
ReDim ArrResult(i)
ReDim ArrC1(i)
ReDim ArrC2(i)
For r = LBound(ArrC1, 1) To UBound(ArrC1, 1)
ArrC1(r) = ArrSel(r, 1)
ArrC2(r) = ArrSel(r, 2)
Next r
ChkLen = 3 ' change this number to be the minimum recognised length, i.e. 1 for a single letter.
If Len(C1Str) > Len(C2Str) Then
tempStr = C2Str
C2Str = C1Str
C1Str = tempStr
End If
For r = LBound(ArrC1, 1) To UBound(ArrC1, 1)
C1Str = ArrC1(r)
lenC1 = Len(C1Str)
C2Str = ArrC2(r)
lenC2 = Len(C2Str)
For x = Len(C1Str) To ChkLen Step -1
For y = 1 To Len(C1Str) - ChkLen
If InStr(C2Str, Trim(Mid(C1Str, y, x))) Then
ArrResult(r) = Trim(Mid(C1Str, y, x))
GoTo MyNxtr
End If
Next y
Next x
MyNxtr:
OffSetCol = 2 ' Change this value to change the offset column.
Next r
For i = LBound(ArrResult) To UBound(ArrResult)
Selection.Cells(1, 1).Offset(i - 1, OffSetCol) = Trim(ArrResult(i))
Next i
MyExitSub:
Application.ScreenUpdating = True
End Sub
``````

Change the value of ChkLen to be the minimum match you are looking for, highlight the two columns to be compared and the result should be placed in the next column (eg, if you select range A2:B10 the results will appear in C2:C10. If you want to change the offset of the result column

paste in a module and link to a button or otherwise run the code from the VBA editor.

• Thanks...it's great! I made some edits to fix errors. Since ArrSel() is an array from Range, it starting from 1 rather than 0. So For Loops must be started from LBound(...)+1 . Sep 4, 2021 at 16:07
• Ah, I forgot to copy the Option Base 1 at the top of the page! it works as is with that option in place, sorry. Sep 4, 2021 at 16:39