Lookup with multiple matches in one cell

[jono67]

Hello,
I`m looking for a formula like =LOOKUP("F";B1:B7;A1:A7) that returns all matches in one cell, not only the first.

Formula needed for result like B10 to B12

A B
1 member1 F
2 member2 S
3 member3 N
4 member4 F
5 member5 S
6 member6 N
7 member7 F
8
9
10 F member1, member4, member7
11 S member2, member5
12 N member3, member6

Thanks /Joe

 

[pgc01]

Hi Joe
Welcome to the board

If you want the solution in the format you posted, a csv string, you have to use vba (yours or an add-in).

You can have a formula solution if it's OK to you to have each value in a different cell (like in the example the values for F in B10, C10 and D10).

Post back your decision.

Kind regards
PGC

 

[jono67]

Hi,
thanks for your quick reply.
As I have to do this on a big list, I will have problems to define cellgroups that are big enough to display all results.
So, I guess, the csv string is neccessary.

Thanks /Joe

 

[pgc01]

Hi again

Assuming the data in A:B starting in row 1 like in the worksheet I post, try:

Sub BuildCSV()
Dim rRng As Range, rCell As Range
Dim vResult, lRow As Long

Set rRng = Range("B1", Range("B" & Rows.Count).End(xlUp))

With CreateObject("Scripting.Dictionary")
    For Each rCell In rRng
        If .exists(rCell.Value) Then
            .Item(rCell.Value) = .Item(rCell.Value) & "," & rCell.Offset(, -1)
        Else
            .Add rCell.Value, rCell.Offset(, -1).Value
        End If
    Next rCell
    
    ReDim vResult(1 To .Count, 1 To 2)
    For Each vkey In .keys
        lRow = lRow + 1
        vResult(lRow, 1) = vkey
        vResult(lRow, 2) = .Item(vkey)
    Next vkey

End With

Application.ScreenUpdating = False
Range("D1").Resize(UBound(vResult), 2) = vResult
Application.ScreenUpdating = True

End Sub

Remarks:
- As you see I build the result in memory (using the array) before writing to the worksheet. This is because you say you have a big list. It's faster this way.
If the list is not that big, you can lose the array and write directly in the worksheet.
- I assumed there is nothing below the list in columns A:B

Hope this helps
PGC

Booky.xls
	A	B	C	D	E	F
1	Member1	A		A	Member1,Member7,Member9,Member14,Member20,Member25
2	Member2	D		D	Member2,Member4,Member5,Member8,Member12,Member18,Member22
3	Member3	C		C	Member3,Member6,Member15,Member17,Member23,Member24
4	Member4	D		B	Member10,Member11,Member13,Member16,Member19,Member21
5	Member5	D
6	Member6	C
7	Member7	A
8	Member8	D
9	Member9	A
10	Member10	B
11	Member11	B
12	Member12	D
13	Member13	B
14	Member14	A
15	Member15	C
16	Member16	B
17	Member17	C
18	Member18	D
19	Member19	B
20	Member20	A
21	Member21	B
22	Member22	D
23	Member23	C
24	Member24	C
25	Member25	A
26
Sheet1

 

[venkat1926]

type or copy unique values down the data
see the sample sheet below (IN THIS SHEET UNIQUE VALUES ARE TYPED a15 TO a17. modify to suit you. the results are in B15 to B17

Book1
	A	B	C	D
1	hdng1	hdng2
2	member1	F
3	member2	S
4	member3	N
5	member4	F
6	member5	S
7	member6	N
8	member7	F
9
10
11
12
13
14
15	F	Fmember1member4member7
16	N	Nmember3member6
17	S	Smember2member5
Sheet1

the run the macro given below

Option Explicit

Sub test()
Dim rng, cfind, rng1, c As Range
Dim i, ilookup As Integer
Dim mmatch As String
mmatch = ""
Set rng = Range("B1:B8") ' modify to suit
Set rng1 = Range("a15:a17")
Set cfind = Range("B1")
For Each c In rng1
ilookup = WorksheetFunction.CountIf(rng, c)
'MsgBox ilookup
For i = 1 To ilookup
Set cfind = rng.Find(what:=c, lookat:=xlWhole, after:=cfind)
'MsgBox cfind.Address
mmatch = mmatch & " " & cfind.Offset(0, -1).Value
'MsgBox mmatch
Next i
c.Offset(0, 1) = cfind & mmatch
mmatch = ""
Next c
End Sub

MODIFY THE MACRO TO SUIT YOUR DATA

 

[jono67]

Hello all,
thanks for your replies!
Your scripts brought us to the right direction!
We are working on the modification...

Kind regards /Joe