Hi Johan,

Am Thu, 11 Apr 2019 11:21:41 -0700 (PDT) schrieb :

Col.A Col.B Col.C Col.D

X123 aaa hhh aaa; hhh CHR(10) bbb; iii CHR(10) ccc; jjj
X123 bbb iii
X123 ccc jjj
A456 ddd kkk ddd; kkk
B678 eee lll eee; lll CHR(10) fff; mmm
B678 fff mmm
C890 ggg nnn ggg; nnn

sorry for my misunderstanding your problem.
Try:

Sub Test()
Dim i As Long, LRow As Long
Dim myCnt As Integer, z As Integer
Dim varTmp As Variant
Dim flag As Boolean
Dim strTmp As String

With ActiveSheet
LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To LRow
strTmp = ""
myCnt = Application.CountIf(.Range("A:A"), .Cells(i, "A"))
If myCnt 1 And Application.CountIf(.Range("A2:A" & i), _
.Cells(i, "A")) = 1 Then flag = True
If flag = True Then
varTmp = .Cells(i, "A").Resize(myCnt, 3)
For z = LBound(varTmp) To UBound(varTmp)
strTmp = strTmp & Chr(10) & varTmp(z, 2) & " ; " & varTmp(z, 3)
Next
.Cells(i, "D") = Mid(strTmp, 2)
flag = False
i = i + myCnt - 1
Else
.Cells(i, "D") = .Cells(i, "B") & " ; " & .Cells(i, "C")
End If
Next
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016