Alter Solution of a thread to " Concatenate Data" solved by MickG

[capson]

I need to Concatenate mulipe discontinuous columns, these columns are constantly changing, so in one project it might be
Columns a, e, g, k, l

And in another
Columns g,k,l,o,aa

There might be a lot of data 100,00 rows so a fast solution is desirable, I found this Here: http://www.excelforum.com/excel-prog...te-tables.html

And a solution to the thread by @MickG and altered it to Concatenate the first two rows but how to generalize it to Concatenate mulipe discontinuous columns?

Thanks

Option Explicit

Private Sub CommandButton21_Click()
Dim Rng As Range, Dn As Range, n As Long, Q As Variant
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not IsEmpty(Dn.Value) Then
        If Not .Exists(Dn.Value) Then
            .Add Dn.Value, Array(Dn.Value, Dn.Offset(, 1) & "|" & Dn.Offset(, 2), "")
        Else
            Q = .Item(Dn.Value)
                Q(2) = Dn.Offset(, 2).Value
            .Item(Dn.Value) = Q
        End If
    End If
Next
Range("I2").Resize(.Count, 3) = Application.Index(.items, 0, 0)
End With

End Sub

[AB33]

.Add Dn.Value, Array(Dn.Value, Dn.Offset(, 1) & "|" & Dn.Offset(, 2), "")

Concatenates columns 2 and 3, using column A as a key.
If you have a single key, you can expand the columns by changing the offset columns.

[jindon]

I see no reason to use Dictionary....
Select Column(s) that you want to concatenate.
It will only concatenate when selected column has value.

Private Sub CommandButton21_Click()
    Dim rng As Range, r As Range, i As Long
    On Error Resume Next
    Set rng = Application.InputBox("Select column(s)", Type:=8)
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub
    With Cells(1).CurrentRegion
        ReDim a(1 To .Rows.Count, 1 To 2)
        a(1, 1) = .Cells(1, 1).Value
        a(1, 2) = "Concat"
        For i = 2 To .Rows.Count
            a(i, 1) = .Cells(i, 1).Value
            For Each r In rng
                If .Cells(i, r.Column) <> "" Then
                    a(i, 2) = a(i, 2) & IIf(a(i, 2) = "", "", "|") & _
                    .Cells(i, r.Column).Value
                End If
            Next
        Next
        With .Offset(, .Columns.Count + 1).Resize(, 2)
            .CurrentRegion.ClearContents
            .Value = a
        End With
    End With
End Sub

[capson]

jindon thank you for the responce,

I tried your code on 4 columns of 9000 rows and it exacuted but the code never completed its action even after 30 minutes

[jindon]

You must be selecting whole column....

Try select one cell in a column

like
A1:D1
A1,C1,F1:G1.... Holding down Ctrl key

[capson]

I uploaded a file with just a few rows to show how the concatenating is working.

The range was [B2:C12]

ColA   ColB
abc    xxx
.      .
.      .
.      .
.      .

I get for the first cell of the concatenated Colunm

abc|xxx|abc|xxx|abc|xxx|abc|xxx|abc|xxx|abc|xxx|abc|xxx|abc|xxx|abc|xxx|abc|xxx|abc|xxx

[jindon]

See my previous post.

Select only one cell a column...

[capson]

jindon pardon me I did not understand, I got it now, thank you

[jindon]

No problem and thanks for the rep.