Question; Combine datafields from different rows into one row and onecolumn if the data in column A is identical
 

Hello,

Sometimes a nice question come up to solve :)

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

It should be (very)great if someone can help me out.

regards, Johan

Question; Combine datafields from different rows into one row and one column if the data in column A is identical
 

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

Question; Combine datafields from different rows into one row andone column if the data in column A is identical
 

Thanks fo your help :)

It looks good and works almost as asked. Thanks so far !!!

I think it went a bit wrong do to my explanation and the way this group shows it in the text.

Combining the fields are good, but it was not mean to combine in new inserted rows, but in the first one and then in column D. The Alt-Enter I wrote was mean as the actioncode "CHR(10)" (=new row in cell)

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

In your macro also the records that are combined in a first row where combined in colum D. This was not required, but you can leave this if it is a problem to leave them as it is now in the code.

regards, Johan

Question; Combine datafields from different rows into one row and one column if the data in column A is identical
 

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

Question; Combine datafields from different rows into one row andone column if the data in column A is identical
 

A-M-A-Z-I-N-G !!!!

Very Thanks a lot. Works very good :)

regards, Johan