This is becoming a popular question. Use TM's function or this macro...
Sub ConcatData()
Dim X As Double
Dim DataArray(5000, 2) As Variant
Dim NbrFound As Double
Dim Y As Double
Dim Found As Integer
Dim NewWks As Worksheet
Cells(1, 1).Select
Let X = ActiveCell.Row
Do While True
If Len(Cells(X, 1).Value) = Empty Then
Exit Do
End If
If NbrFound = 0 Then
NbrFound = 1
DataArray(1, 1) = Cells(X, 1)
DataArray(1, 2) = Cells(X, 2)
Else
For Y = 1 To NbrFound
Found = 0
If DataArray(Y, 1) = Cells(X, 1).Value Then
DataArray(Y, 2) = DataArray(Y, 2) & ", " & Cells(X, 2)
Found = 1
Exit For
End If
Next
If Found = 0 Then
NbrFound = NbrFound + 1
DataArray(NbrFound, 1) = Cells(X, 1).Value
DataArray(NbrFound, 2) = Cells(X, 2).Value
End If
End If
X = X + 1
Loop
Set NewWks = Worksheets.Add
NewWks.Name = "SummarizedData"
Cells(1, 1).Value = "Names"
Cells(1, 2).Value = "Results"
X = 2
For Y = 1 To NbrFound
Cells(X, 1).Value = DataArray(Y, 1)
Cells(X, 2).Value = DataArray(Y, 2)
X = X + 1
Next
Beep
MsgBox ("Summary is done!")
End Sub
Regards,
Ryan---
--
RyGuy
"Teethless mama" wrote:
Download and install the free add-in Morefunc.xll from:
http://xcell05.free.fr/english/
Then use these formula
Note: "InvNo" and "SerialNo" are defined name ranges
To Get the unique record:
In D2:
=IF(ISERR(SMALL(IF(MATCH(InvNo,InvNo,0)=ROW(INDIRE CT("1:"&ROWS(InvNo))),MATCH(InvNo,InvNo,0)),ROWS($ 1:1))),"",INDEX(InvNo,SMALL(IF(MATCH(InvNo,InvNo,0 )=ROW(INDIRECT("1:"&ROWS(InvNo))),MATCH(InvNo,InvN o,0)),ROWS($1:1))))
ctrl+shift+enter, not just enter
copy down
In E2: =SUBSTITUTE(TRIM(MCONCAT(IF(InvNo=$D2,SerialNo,"") &" "))," ",",")
ctrl+shift+enter, not just enter
copy down
"Michael D" wrote:
I have the following data:
A B
Inv No. Serial No.
0001 ABC
0001 DEF
0001 GHI
0002 JKL
0002 MNO
0002 PQR
and need to come back to this:
Inv No. Serial No
0001 ABC, DEF, GHI
0002 JKL, MNO, PQR
Would anyone be able to help me out