Entering Different Cell Values into one Cell

[carabale]

I have a worksheet with different names. Each name might have 1 to 5 rows with comments. I want all the comments on the first line. For example:

SSN NAME COMMENT COMMENTATOR
001 PERSON1 COMMENT1 JUDGE1
001 PERSON1 COMMENT2 JUDGE2
002 PERSON2 COMMENT1 JUDGE1
003 PERSON3 COMMENT1 JUDGE1
003 PERSON3 COMMENT2 JUDGE2
003 PERSON3 COMMENT3 JUDGE3
003 PERSON3 COMMENT4 JUDGE4

I want this:

SSN NAME COMMENT
001 PERSON1 COMMENT1, COMMENT2
002 PERSON2 COMMENT1
003 PERSON3 COMMENT1, COMMENT2, COMMENT3, COMMENT4

I figure a VB will do it. Once I get the worksheet the way I need it, I will mail merge to Word. However, I can figure that part myself.

Thank you in advance for your assistance.

 

[Webbarr]

Can you not just use a Pivot Table? Make sure it's shown as tabular, don't repeat item labels / remove sub totals & grand totals etc...

 

[Peter_SSs]

Assuming the data is sorted by Name and that you want the original data overwritten (so test in a copy of your workbook), try this.

Sub CombineComments()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
  
  With Range("A1", Range("C" & Rows.Count).End(xlUp))
    a = .Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    For i = 2 To UBound(a)
      If a(i, 1) = a(i - 1, 1) Then
        b(k, 3) = b(k, 3) & ", " & a(i, 3)
      Else
        k = k + 1
        b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = a(i, 3)
      End If
    Next i
    .Offset(1).Value = b
    .Columns(4).ClearContents
    .Columns.AutoFit
  End With
End Sub

Before:

Book1
	A	B	C	D
1	SSN	NAME	COMMENT	COMMENTATOR
2	1	PERSON1	COMMENT1	JUDGE1
3	1	PERSON1	COMMENT2	JUDGE2
4	2	PERSON2	COMMENT1	JUDGE1
5	3	PERSON3	COMMENT1	JUDGE1
6	3	PERSON3	COMMENT2	JUDGE2
7	3	PERSON3	COMMENT3	JUDGE3
8	3	PERSON3	COMMENT4	JUDGE4
Combine comments

After:

Book1
	A	B	C	D
1	SSN	NAME	COMMENT
2	1	PERSON1	COMMENT1, COMMENT2
3	2	PERSON2	COMMENT1
4	3	PERSON3	COMMENT1, COMMENT2, COMMENT3, COMMENT4
5
Combine comments

 

[Kaper]

edit: whoops, not noticed last post. ANyway as the approach (while similar) is a bit different, I'm leaving it here.


So if you opt for VBA try:

Sub test()
Dim dataarray, i As Long, lastrow As Long
Columns("d:d").ClearContents 'not needed info about commentators
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
dataarray = Range("A1:C" & lastrow).Value
For i = 2 To UBound(dataarray)
  If dataarray(i, 1) = dataarray(i - 1, 1) Then
    dataarray(i, 3) = dataarray(i - 1, 3) & ", " & dataarray(i, 3)
    dataarray(i - 1, 3) = ""
  End If
Next i
Range("A1:C" & lastrow) = dataarray
Range("A1:C" & lastrow).AutoFilter field:=3, Criteria1:=""
Rows("2:" & lastrow + 1).Delete shift:=xlUp
ActiveSheet.AutoFilterMode = False
End Sub