View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
akaDong akaDong is offline
external usenet poster
 
Posts: 2
Default Merging multiple cells into a single cell

Wow!! thank you .... you're a genius !! (^^,)

"Ron Rosenfeld" wrote:

On Sun, 22 Feb 2009 14:49:01 -0800, akaDong
wrote:

Dear all,

please help me, i have a two column data. I need to merge data from column
b with the same data in column a into a single cell separated by ";". the
sheet looks as follows:

---A--- ---B---
Job ID Name

335119 Malonzo, Elaine
335119 Monsalve, Edmund
335119 Pilapil, Flofer
335119 Pilapil, Flofer
335119 Santiago, Minerva
335212 Calub, Charina
335212 Calub, Charina
335212 Calub, Charina
335212 Requita, Darius
335212 Santiago, Minerva
335253 Bonifacio, DaisyLou
335253 Bonifacio, DaisyLou
335253 Delos Santos, Veronica
335253 Delos Santos, Veronica
335253 Llamas-Ong, Christine
335253 Llamas-Ong, Christine
335253 Reyes, Wilson

I need it to look like this....

---A--- ---B------------------------------------
Job ID Name

335119 Malonzo, Elaine; Monsalve, Edmund; Pilapil, Flofer; Santiago, Minerva
335212 Calub, Charina; Requita, Darius; Santiago, Minerva
335253 Bonifacio, DaisyLou; Delos Santos, Veronica; Llamas-Ong, Christine


Hoping to have an answer.

best regards,
akaDong


Looking at your output, it appears you want to have only unique names output.
The following macro does not depend on your data being sorted. If your
original data is not sorted, and you want the output sorted, some sort routines
can be added to the macro.

Read the comments in the macro for additional, important information.

To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro
by name, and <RUN.

===========================================
Option Explicit

Sub JobIDNameCombine()
'look for Job ID and combine all the
'Names under that ID.
'Names and Job ID's do NOT need to be sorted but
'unless you add a sort routine, they will be output in
'the order of first entry

Dim rJobID As Range
Dim rDest As Range
Dim c As Range
Dim sJobID As String
Dim cJobID As Collection
Dim cName As Collection
Dim sNames() As String
Dim i As Long, j As Long
Dim k As Long

Set rJobID = Range("Job_ID") 'This is a Named Range on the worksheet
'you could also use "selection" or any number of other ways of
'setting the range of Job ID's

Set rDest = Range("D1") ' or wherever

'Clear destination cells and print headers
'Max number to clear would be count of Job ID's

Range(rDest, rDest.Offset(rJobID.Rows.Count - 1, 1)).ClearContents
rDest.Value = "Job ID"
rDest.Offset(0, 1).Value = "Names"

'get unique list of Job ID's

Set cJobID = New Collection
On Error Resume Next
For Each c In rJobID
cJobID.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0

k = 0
For i = 1 To cJobID.Count
Set cName = New Collection
On Error Resume Next
For Each c In rJobID
If c.Value = cJobID(i) Then
cName.Add c.Offset(0, 1).Value, CStr(c.Offset(0, 1).Value)
End If
Next c
On Error GoTo 0
ReDim sNames(cName.Count - 1)
For j = 0 To UBound(sNames)
sNames(j) = cName(j + 1)
Next j
k = k + 1
rDest.Offset(k, 0).Value = cJobID(i)
rDest.Offset(k, 1).Value = Join(sNames, "; ")
Next i

Set cJobID = Nothing
Set cName = Nothing
End Sub
--ron