View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Howard Howard is offline
external usenet poster
 
Posts: 536
Default 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