If value in a colum the same concatenate another colume
On Friday, August 30, 2013 5:09:58 PM UTC-7, wrote:
Hi
This is tricky to explain so I will show the output I want below, basically if the same unique value is in one column I would like to concatenate values from those unique value in the existing column to create one row. Easier to demonstrate. I wonder would anyone know some macro code to achieve this.
Head1 Head2
123 joe
154 steve
123 tom
129 kate
to give
head1 head2
123 joe,tom
154 steve
129 kate
Thank you for any help
Try this, From my archives, I don't recall the author.
Option Explicit
Sub Test()
Dim LRow1 As Long
Dim LRow2 As Long
Dim i As Long
Dim j As Long
Dim rngC As Range
Dim c As Range
Dim firstAddress As String
Dim myStr As String
j = 1
LRow1 = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LRow1
If WorksheetFunction.CountIf(Range(Cells(1, 1), _
Cells(i, 1)), Cells(i, 1)) = 1 Then
Cells(j, 3) = Cells(i, 1)
j = j + 1
End If
Next
LRow2 = Cells(Rows.Count, 3).End(xlUp).Row
For Each rngC In Range("C1:C" & LRow2)
myStr = ""
With Range("A1:A" & LRow1)
Set c = .Find(rngC, after:=Cells(LRow1, 1), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
myStr = myStr & c.Offset(0, 1) & ", "
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
rngC.Offset(0, 1) = Left(myStr, Len(myStr) - 2)
End If
End With
Next
End Sub
|