Display all matching values in one comma separated cell

[lacviet2005]

Hi all,

I have two columns of data in an Excel 2010 spreadsheet. A is Quote_Number and Column B is Sale_Rep. There will be multiple values in Column B for each Quote_Number in Column A.
What I want to achieve is to display all of the values for each Quote_Number in another cell, separated by commas.
For example:
A B
------------------------------
| Quote_Number | Sales_Rep |
------------------------------
| 1001 | Doe, John |
| 1002 | Smith, B |
| 1003 | Bob, D |
| 1004 | Doe, John |
| 1005 | Doe, John |
| 1006 | Bob, D |
| 1007 | Bob, D |
| 1008 | Doe, John |
-----------------------------
I'd want to display the following in cell D: 1001, 1004, 1005, 1008

Can this be achieved with a formula? I've been Googling for help, but none. Please help!

Thank you.

[mancubus]

hi.

try this. writes unique list of sales reps in Column F and their quote nums in Col G. change to suit.



Sub unq_list_with_corresp_valz()


Dim SalesRep As String, QNums As String
Dim LastRow As Long, i As Long, j As Long
Dim UqSR, cll As Range

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

For Each cll In Range("B2:B" & LastRow)
If InStr(SalesRep, cll.Value) = 0 Then SalesRep = SalesRep & "|" & cll.Value
Next

UqSR = Application.Transpose(Split(Mid(SalesRep, 2), "|"))

With Range("F1:G1")
.Value = Array("Sales_Rep", "Results")
.Font.Bold = True
End With
Range("F2").Resize(UBound(UqSR)) = UqSR


For i = 2 To UBound(UqSR) + 1
For j = 2 To LastRow
If Cells(i, "F") = Cells(j, "B") Then QNums = QNums & ", " & Cells(j, "A")
Next j
Cells(i, "G") = Mid(QNums, 3)
QNums = ""
Next i


End Sub

[Paul_Hossler]

Someone else had a similar question recently:

http://www.vbaexpress.com/forum/show...n-Lookup-Value (http://www.vbaexpress.com/forum/showthread.php?48752-Return-Multiple-Values-based-on-Lookup-Value)

I suggested a simple user defined function, and that OP seems to like it




Option Explicit

'Usage: =Quotes(B2,$A:$A,$B:$B)
Function Quotes(SalesRep As String, RangeQuotes As Range, RangeReps As Range) As String
Dim s As String
Dim r As Range

For Each r In Intersect(RangeReps.Columns(1), RangeReps.Parent.UsedRange).Cells
If r.Value = SalesRep Then
s = s & Intersect(r.EntireRow, RangeQuotes.Columns(1)).Value & ", "
End If
Next

If Len(s) > 0 Then s = Left(s, Len(s) - 2)

Quotes = s
End Function



It's not very elegant, and could use some error checking, but is simple

Paul