Macro Needed to Concatenate Data in separate ROWS

Originally Posted by jindon

http://www.excelforum.com/excel-prog...ml#post3981768
Change to

Sub test()
    Dim a, i As Long
    With Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2)
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 1 To UBound(a, 1)
                If a(i, 1) <> "" Then
                    If Not .exists(a(i, 1)) Then
                        .Item(a(i, 1)) = .Count + 1
                        a(.Item(a(i, 1)), 1) = a(i, 1)
                        a(.Item(a(i, 1)), 2) = a(i, 2)
                    Else
                        a(.Item(a(i, 1)), 2) = _
                        Join(Array(a(.Item(a(i, 1)), 2), a(i, 2)), "-")
                    End If
                End If
            Next
            i = .Count
        End With
        .Offset(, .Columns.Count + 2).Resize(i, 2).Value = a
    End With
End Sub

Sorry but It doesn't appears nothing on sheet 2 with this code;
And with the previous thread code you coded, with a large file sometimes It doesn't appear nothing or It says "end of memory error"