Multiple Lookup And Return All Values Concatenated With Delimiter

[Prabhu]

Hi,

I need to compare tow columns and get the matched result in single cell.

Attached sample data for your reference.

Thanks,
Prabhu

[Excel Fox]

Use this



Sub SMC()

Dim rngSource As Range
Dim var As Variant, varOut As Variant, varOutCombin As Variant
Dim lngRow As Long, lngCol As Long
Dim objDic As Object
Set objDic = CreateObject("Scripting.Dictionary")
Set rngSource = Range("A2:B14")
var = rngSource.Value2
For lngRow = LBound(var) + 1 To UBound(var)
For lngCol = LBound(var, 2) To UBound(var, 2)
If IsEmpty(var(lngRow, lngCol)) Then
var(lngRow, lngCol) = var(lngRow - 1, lngCol)
Else
If lngCol = LBound(var, 2) Then
objDic.Item(var(lngRow, lngCol)) = 0
End If
End If
Next lngCol
Next lngRow
varOut = objDic.Keys
ReDim varOutCombin(1 To objDic.Count)
For lngRow = LBound(var) + 1 To UBound(var)
For lngCol = LBound(varOut) To UBound(varOut)
If var(lngRow, 1) = varOut(lngCol) Then
If IsEmpty(varOutCombin(lngCol + 1)) Then
varOutCombin(lngCol + 1) = var(lngRow, 2)
Else
varOutCombin(lngCol + 1) = varOutCombin(lngCol + 1) & "," & var(lngRow, 2)
End If
End If
Next lngCol
Next lngRow
rngSource.Offset(1).ClearContents
rngSource(2, 1).Resize(5).Value = Application.Transpose(varOut)
rngSource(2, 2).Resize(5).Value = Application.Transpose(varOutCombin)

End Sub

[aju.thomas]

Hi,

I am not sure a formula can do your work, so i have created a macro to do it.

[Admin]

Hi

.. with one loop..


Sub kTest()

Dim k, i As Long, sKey As String, sItems As String, d As Object

k = Range("a2").CurrentRegion.Resize(, 2).Value2

Set d = CreateObject("scripting.dictionary")
d.comparemode = 1

For i = 2 To UBound(k, 1)
If LenB(k(i, 1)) Then sKey = k(i, 1)
If LenB(sKey) Then
sItems = d.Item(sKey)
If LenB(sItems) Then
d.Item(sKey) = sItems & "," & k(i, 2)
Else
d.Item(sKey) = k(i, 2)
End If
End If
Next

With Range("d10")
.Resize(d.Count) = Application.Transpose(d.keys)
.Offset(, 1).Resize(d.Count) = Application.Transpose(d.items)
End With

End Sub

[Prabhu]

Thank you all!