VBA: Add Chr(10) into code when concatenating

[FryGirl]

I posted a thread a while back and received some help for concatenating. This code worked great for what I was doing then and will work (I think) for this scenario, but instead of the "/" separating concatenated values, I would rather a line break. So, as you can see in row 14 and row 15, I'd like to see the M and N in column E to be separated by a line break instead of the "/". I tried placing a Chr(10) in the code, but it adds an extra space on top of the concatenated values. In this example it only show two duplicates, but there could be more than just two.

Calendar.xlsm
	A	B	C	D	E
1	Number	Letter		Number	Letter
2	1--5	A		1--5	A
3	1--22	B		1--22	B
4	1--26	C		1--26	C
5	2--4	D		2--4	D
6	2--8	E		2--8	E
7	2--12	F		2--12	F
8	2--20	G		2--20	G
9	2--23	H		2--23	H
10	2--24	I		2--24	I
11	2--26	J		2--26	J
12	3--6	K		3--6	K
13	3--14	L		3--14	L
14	3--15	M		3--15	M / N
15	3--15	N		3--16	O
16	3--16	O		3--19	P
17	3--19	P		3--21	Q
18	3--21	Q		4--5	R
19	4--5	R		4--20	S
20	4--20	S		4--29	T
21	4--29	T		5--4	U / V
22	5--4	U		5--14	W
23	5--4	V		5--24	X
24	5--14	W
25	5--24	X
Sheet2

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A2:B25	Cell Value	duplicates	text	NO

Sub Test()
  Dim R As Long, Data As Variant
  Data = Sheets("Sheet2").Range("A2", Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp))
  Sheets("Sheet2").Range("A1:B1").Copy Sheets("Sheet2").Range("D1:E1")
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Data)
      .Item(Data(R, 1)) = .Item(Data(R, 1)) & " / " & Data(R, 2)
      If Left(.Item(Data(R, 1)), 3) = " / " Then .Item(Data(R, 1)) = Mid(.Item(Data(R, 1)), 4)
    Next
    Sheets("Sheet2").Range("D2").Resize(.Count) = Application.Transpose(.Keys)
    Sheets("Sheet2").Range("E2").Resize(.Count) = Application.Transpose(.Items)
  End With
End Sub

 

[Fluff]

How about

Sub Test()
  Dim R As Long, Data As Variant
  Data = Sheets("Sheet2").Range("A2", Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp))
  Sheets("Sheet2").Range("A1:B1").Copy Sheets("Sheet2").Range("D1:E1")
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Data)
      If Not .Exists(Data(R, 1)) Then
         .Item(Data(R, 1)) = Data(R, 2)
      Else
         .Item(Data(R, 1)) = .Item(Data(R, 1)) & vbLf & Data(R, 2)
      End If
    Next
    Sheets("Sheet2").Range("D2").Resize(.Count) = Application.Transpose(.Keys)
    Sheets("Sheet2").Range("E2").Resize(.Count) = Application.Transpose(.Items)
  End With
End Sub

 

[FryGirl]

Perfect as always. Many thanks Fluff.

 

[Fluff]

You're welcome & thanks for the feedback.