Macro which can combine a list of notes into a single cell

[glide2131]

Hello,

I have a long list of records and each record has a list of notes. Some have one note and others have many lines of notes. What I need to do is combine all the notes for each record into one cell. I know how to do this manually using TextJOIN but I have thousands of records and going through each manually would take forever. I am looking for a macro that can combine all of the notes into one cell by record. Or in other words, there should be one cell with all the combined notes per record (ID in my example)I have attached a spreadsheet as an example of what I need.

Please help.

Thanks!

 

[Akuini]

Hi, @glide2131
Try this:

Sub a1168029a()
Dim i As Long, j As Long, k As Long
Dim va, vb, vc

n = Range("C" & Rows.Count).End(xlUp).Row
va = Range("C2:C" & n)
vb = Range("B2:B" & n)

ReDim vc(1 To UBound(va, 1), 1 To 1)

For i = 1 To UBound(va, 1)
 j = i
    Do
        i = i + 1
        If i > UBound(va, 1) Then Exit Do
    Loop While va(i, 1) = va(i - 1, 1)
    i = i - 1
    
    tx = ""
    For k = j To i
        tx = tx & vb(k, 1) & vbLf
    Next
    
    tx = Left(tx, Len(tx) - 1)
    vc(j, 1) = tx
    
Next

Range("A2").Resize(UBound(vc, 1), 1) = vc

End Sub

Book1
	A	B	C
1	COMBINE	NOTE	ID
2	Cayson Roman Zayn	Cayson	A
3		Roman	A
4		Zayn	A
5	Ari	Ari	B
6	Abraham Arian Damian	Abraham	M
7		Arian	M
8		Damian	M
9	Marvin Erick Owen	Marvin	O
10		Erick	O
11		Owen	O
12	Leandro Jedidiah Landyn	Leandro	U
13		Jedidiah	U
14		Landyn	U
15	Anson	Anson	X
Sheet1

 

[Zot]

Another old school option ?

Sub JoinTextCell()

Dim strNote As String
Dim prvID As Long, ID As Long, rowNote As Long
Dim cell As Range, rngNote As Range

Set rngNote = Range("D3", Cells(Rows.Count, "D").End(xlUp))

For Each cell In rngNote
newID:
    If prvID = 0 Then
        rowNote = cell.Row
        prvID = cell.Value2
    End If
    ID = cell.Value2
    If ID = prvID Then
        If strNote = "" Then
            strNote = cell.Offset(0, -1).Value2
        Else
            strNote = strNote & vbLf & cell.Offset(0, -1).Value2
        End If
    Else
        Range("B" & rowNote) = strNote
        prvID = 0
        strNote = ""
        GoTo newID
    End If
Next

End Sub

 

[Fluff]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

You can do that without a macro like

=IF(COUNTIFS(C$2:C2,C2)=1,TEXTJOIN(CHAR(10),,FILTER($B$2:$B$1000,$C$2:$C$1000=C2)),"")

 

[Fluff]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Macro: Combining a list of notes into one cell
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[glide2131]

Thank you!

 

[Fluff]

Glad we could help & thanks for the feedback.