Find Common Text in 3 Rows: VBA

[lafata2000]

Hi everyone,

I have the below VBA code; however, I need it edited a bit and need some help!!!

Current Results: The code is taking the most frequent text from all 3 columns as a whole

Column 1	Column 2	Column 2		Results
ABSBR KIT	RS5000X SHOCK	SHOCK ABSORBER		SHOCK

Needed Results: The code to take the most frequent text from all 3 columns together and show results as blank if there is no match.

Column 1	Column 2	Column 2		Results
ABSBR KIT	RS5000X SHOCK	SHOCK ABSORBER

Sub jec()

Dim dict As Object
Dim jv, ar, sp, it As Variant
Dim i As Long
Dim c00 As String

Set dict = CreateObject("scripting.dictionary")
dict.CompareMode = 1
jv = Sheets(1).Cells(1, 1).CurrentRegion.Resize(, 5)

For i = 2 To UBound(jv)
ar = Split(Replace(Join(Array(jv(i, 1), jv(i, 2), jv(i, 3))), ",,", " "))
With Cells(1, 100).Resize(UBound(ar) + 1)
.ClearContents
.Value = Application.Transpose(ar)
sp = Filter(Application.Transpose(Evaluate(Replace("if(max(countif(@@,@@))=countif(@@,@@),@@,""~"")", "@@", .Address))), "~", False)
End With

For Each it In sp
c00 = dict(it)
Next

jv(i, 5) = Join(dict.keys, ", ")
dict.RemoveAll
Next

Sheets(1).Cells(1, 1).CurrentRegion.Resize(, 5) = jv
End Sub

 

[Marc L]

Hi, according to your 'attachment' a VBA demonstration for starters :​

Sub Demo1()
    Dim V, S$(), R&, W
        V = [A1].CurrentRegion.Value2:  If UBound(V) = 1 Then Beep: Exit Sub
        ReDim S(2 To UBound(V), 0)
    With Application
    For R = 2 To UBound(V)
        V(R, 2) = Split(V(R, 2)):  V(R, 3) = Split(V(R, 3))
    For Each W In Split(V(R, 1))
        If IsNumeric(.Match(W, V(R, 2), 0)) And IsNumeric(.Match(W, V(R, 3), 0)) Then S(R, 0) = S(R, 0) & W & " "
    Next W, R
    End With
        [E2].Resize(R - 2).Value2 = S
End Sub