Re: Lookup multiple values in a single cell without using Excel VBA
Hi Nabilah,
try this
Code
Sub ertert()
Dim x, i&, j&, k&
With Sheets("Database")
If .FilterMode Then .ShowAllData
x = .Range("A1:C" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 1 To UBound(x)
If .Exists(x(i, 1)) Then
k = .Item(x(i, 1))
If InStr(x(k, 2), x(i, 2)) = 0 Then x(k, 2) = x(k, 2) & ", " & x(i, 2)
If InStr(x(k, 3), x(i, 3)) = 0 Then x(k, 3) = x(k, 3) & ", " & x(i, 3)
Else
j = j + 1: .Item(x(i, 1)) = j
x(j, 1) = CStr(x(i, 1))
x(j, 2) = x(i, 2)
x(j, 3) = x(i, 3)
End If
Next i
End With
With Sheets("Summary")
.UsedRange.ClearContents
.Range("B2:D2").Resize(j).Value = x
.Activate
End With
End Sub
Display More