Excel Cell common Text

[imgaur7]

Hi,

I am trying to find the common/repeated text in Cell A2 AND Cell B2 and show the results in Cell C3

Eg:
Cell A2
Nice Job, agent 104

Cell B2
Great and nice, but what about 106

Result
Cell C3
nice

Referred some of the posts but they compare with the whole column which is not required here. Kindly check

 

[Takae]

C3? not C2?
Hope this helps.

Sub test()
Dim Dic, tmp, buf As String, buf2 As String
Dim i As Long, j As Long, k As Long
For i = 2 To cells(Rows.count, 1).End(xlUp).Row
    Set Dic = CreateObject("Scripting.Dictionary")
        For k = 1 To 2
            buf = StrConv(WorksheetFunction.Substitute(cells(i, k).Value, ",", ""), vbLowerCase)  
            tmp = split(buf, " ")
            For j = 0 To UBound(tmp)
                If Not Dic.Exists(tmp(j)) Then
                    Dic.Add tmp(j), tmp(j)
                Else
                    buf2 = buf2 & tmp(j) & ","
                End If
            Next
        Next
        cells(i + 1, 3).Value = Left(buf2, Len(buf2) - 1)
        buf = ""
        buf2 = ""
    Set Dic = Nothing
Next
End Sub

 

[imgaur7]

C3? not C2?
Hope this helps.

Sub test()
Dim Dic, tmp, buf As String, buf2 As String
Dim i As Long, j As Long, k As Long
For i = 2 To cells(Rows.count, 1).End(xlUp).Row
    Set Dic = CreateObject("Scripting.Dictionary")
        For k = 1 To 2
            buf = StrConv(WorksheetFunction.Substitute(cells(i, k).Value, ",", ""), vbLowerCase)  
            tmp = split(buf, " ")
            For j = 0 To UBound(tmp)
                If Not Dic.Exists(tmp(j)) Then
                    Dic.Add tmp(j), tmp(j)
                Else
                    buf2 = buf2 & tmp(j) & ","
                End If
            Next
        Next
        cells(i + 1, 3).Value = Left(buf2, Len(buf2) - 1)
        buf = ""
        buf2 = ""
    Set Dic = Nothing
Next
End Sub

Typo error my bad its C2
Thanks for your help...

I am getting this error while running the code

Run-time error "5"
Invalid procedure call or argument

 

[Takae]

ColumnA or B have single word?

 

[imgaur7]

ColumnA or B have single word?

Mostly Yes in Col A, BUT some times it might be 2 -3 words as well.

--------------------
Really would like to thank you for all the help.



----------------------------------------------------------------------------------------------------------------------------
(Another thread different issue still not able to get any solution )
Also if possible kindly check if it looks workable
https://www.mrexcel.com/forum/excel...a-code-sample-ie-excel.html?highlight=imgaur7

 

[imgaur7]

Following eg might help you (its in table format in excel)

[TABLE="width: 462"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD="align: left"]Table 1[/TD]
[TD="align: left"]Table 2[/TD]
[TD="align: left"]Solution[/TD]
[/TR]
[TR]
[TD="align: left"]Nice picture![/TD]
[TD="align: left"]What do you love the most about this picture[/TD]
[TD="align: left"]picture[/TD]
[/TR]
[TR]
[TD="align: left"]Nice picture![/TD]
[TD="align: left"]nice do you love the picture[/TD]
[TD="align: left"]nice[/TD]
[/TR]
[TR]
[TD="align: left"]Great[/TD]
[TD="align: left"]Thanks and great[/TD]
[TD="align: left"]great[/TD]
[/TR]
[TR]
[TD="align: left"]Nice picture for sure[/TD]
[TD="align: left"]nice do you love the picture for sure[/TD]
[TD="align: left"]picture, sure[/TD]
[/TR]
</tbody>[/TABLE]

 

[Takae]

mmm?
The second line solution should be "nice, picture" and fourth line should be "nice,picture,for,sure".
Please check the code as below.

Sub test()
Dim Dic, tmp, buf As String, buf2 As String, str As String
Dim i As Long, j As Long, k As Long
For i = 2 To cells(Rows.count, 1).End(xlUp).Row
Set Dic = CreateObject("Scripting.Dictionary")
    buf = cells(i, 1).Value & " " & cells(i, 2).Value
    For j = 1 To Len(buf)
        If Mid(buf, j, 1) Like "[ ,a-z,A-Z]" Then
            str = str & Mid(buf, j, 1)
        End If
    Next
    buf = StrConv(str, vbLowerCase)
    tmp = split(buf, " ")
    For k = 0 To UBound(tmp)
        If Not Dic.Exists(tmp(k)) Then
            Dic.Add tmp(k), tmp(k)
        Else
            buf2 = buf2 & tmp(k) & ","
        End If
    Next
    If Len(buf2) > 0 Then
        cells(i, 3).Value = Left(buf2, Len(buf2) - 1)
    End If
    buf2 = ""
    str = ""
    Set Dic = Nothing
Next
End Sub

 

[imgaur7]

Takae You are man. Wow, that works as anything thanks buddy..... thanks a lot for all your time appreciated !!!


(I am not sure if I may ask but kindly check my other question
Link : https://www.mrexcel.com/forum/excel...a-code-sample-ie-excel.html?highlight=imgaur7)