Hi Johan,

Am Thu, 11 Apr 2019 07:01:30 -0700 (PDT) schrieb :

Col.A Col.B Col.C

X123 aaa hhh
X123 bbb iii
X123 ccc jjj
A456 ddd kkk
B678 eee lll
B678 fff mmm
C890 ggg nnn

From row 1 till last; for all the records where in Col.A the data is the same, then combine the data in Col.B and C from those records, into the first row in Col.D.
The combined data into Col.D should be Col.B & ; & Col.C then AltEnter then Col.B & Col.C form the next row etc..
If there are no double rows (datafield in Col.A) then combine for that row only the data in Col.B and C to Col.D

Above result then in

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

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

try:

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

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


Regards
Claus B.
--
Windows10
Office 2016