Combined multi columns values in one column separated by coma

[motilulla]

Hello,

In 5 columns A:E are filled values (it can be vary in amount but always value will be in entered in ascending order in all columns)

Need VBA which combine them in column G separated by coma my excel row limit is 65536 if there are more then that continue in next columns H, I, J, till finish.

Important combine next value must be grater then previous for example pick number 3^rd 6 not 4 so first combine find 1,4,6,19,23 (not 1,4,4,19,23)

Row Num	A	B	C	D	E		G
1	1	4	4	19	23		1,4,6,19,23
2	4	6	6	22	24		1,4,6,19,24
3	7	8	14	23	32		1,4,6,19,32
4	11	10	16	24	57		1,4,6,19,57
5	12	12	19	25	38		1,4,6,19,38
6	14	14	22	26	39		1,4,6,19,39
7	15	22	23	27	42		1,4,6,19,42
8	16	24	24	34	45		1,4,6,19,45
9		25	26	37	47		1,4,6,19,47
10		32	32	39	52		1,4,6,19,52
11		35	34	42	57		1,4,6,19,62
12			35	44	62		1,4,6,19,64
13			36	62	64		1,4,6,19,70
14			42		70		1,4,6,19,99
15					99		1,4,6,19,101
16					101		1,4,6,19,105
17					105		1,4,6,22,23
18							1,4,6,22,24
19							1,4,6,22,32
20							1,4,6,22,57
21							1,4,6,22,38
22							1,4,6,22,39
23							1,4,6,22,42

Thank You

Regards,
Moti

[mdmackillop]

Why not post a workbook containing your data?

[motilulla]

Combined multi columns.xls

Why not post a workbook containing your data?

Mdmackillop, here is workbook attached, I tried manually to show require results in column G

Combined multi columns.xls

Thank you

Regards,
Moti

[mdmackillop]

Try this

Sub Test()
    y = 7
    For i = 1 To Application.CountA(Columns(1))
        For j = 1 To Application.CountA(Columns(2))
            For k = 1 To Application.CountA(Columns(3))
                For l = 1 To Application.CountA(Columns(4))
                    For m = 1 To Application.CountA(Columns(5))


                        a = Cells(i, 1)
                        b = Cells(j, 2)
                        c = Cells(k, 3)
                        d = Cells(l, 4)
                        e = Cells(m, 5)


                        If Not (IsError(Application.Match(a, Array(b, c, d, e), 0))) Then Exit For
                        If Not (IsError(Application.Match(b, Array(a, c, d, e), 0))) Then Exit For
                        If Not (IsError(Application.Match(c, Array(a, b, d, e), 0))) Then Exit For
                        If Not (IsError(Application.Match(d, Array(a, b, c, e), 0))) Then Exit For
                        If Not (IsError(Application.Match(e, Array(a, b, c, d), 0))) Then Exit For


                        If x = 65000 Then
                            x = 0
                            y = y + 1
                        End If
                        x = x + 1
                        Cells(x, y) = Join(Array(a, b, c, d, e), ",")


                    Next
                Next
            Next
        Next
    Next
End Sub

[motilulla]

Try this

Sub Test()
End Sub

mdmackillop, Please could you check it is not combining columns as I specified in opening post important combine next value must be grater then previous

I run the code and find for example in cell G 52494 (12,4,6,19,23) so if it is picking 12 from column A it has to find in column B grater then 12 which is 14 not 4 so combine must be (12,14,16,19,23 instead) attached table

1	4	4	19	23
4	6	6	22	24
7	8	14	23	32
11	10	16	24	57
12	12	19	25	38
14	14	22	26	39
15	22	23	27	42
16	24	24	34	45
	25	26	37	47
	32	32	39	52
	35	34	42	57
		35	44	62
		36	62	64
		42		70
				99
				101
				105

Thank you

Regards,
Moti

[mdmackillop]

What have you tried to resolve this? Please post your revision to the code.

[motilulla]

What have you tried to resolve this? Please post your revision to the code.

mdmackillop, no nothing my request is to you. Please can you resolve it?

Regards,
Moti

[mdmackillop]

We are not here to provide a free coding service, but to assist in your learning of VBA.

[motilulla]

We are not here to provide a free coding service, but to assist in your learning of VBA.

Hello mdmackillop,

I really appreciate your time and help

Thank you very much

Regards,
Moti

[mdmackillop]

There was an error in my previous post so use this.

Sub Test()
    y = 7
    For i = 1 To Application.CountA(Columns(1))
        For j = 1 To Application.CountA(Columns(2))
            For k = 1 To Application.CountA(Columns(3))
                For l = 1 To Application.CountA(Columns(4))
                    For m = 1 To Application.CountA(Columns(5))
                        a = Cells(i, 1)
                        b = Cells(j, 2)
                        c = Cells(k, 3)
                        d = Cells(l, 4)
                        e = Cells(m, 5)
                        Arr = Array(a, b, c, d, e)
                        If Not (IsError(Application.Match(a, Array(b, c, d, e), 0))) Then GoTo bb
                        If Not (IsError(Application.Match(b, Array(a, c, d, e), 0))) Then GoTo bb
                        If Not (IsError(Application.Match(c, Array(a, b, d, e), 0))) Then GoTo bb
                        If Not (IsError(Application.Match(d, Array(a, b, c, e), 0))) Then GoTo bb
                        If Not (IsError(Application.Match(e, Array(a, b, c, d), 0))) Then GoTo bb
                        
                        If Not (a = Application.WorksheetFunction.Small(Arr, 1)) Then GoTo bb
                        If Not (b = Application.WorksheetFunction.Small(Arr, 2)) Then GoTo bb
                        If Not (c = Application.WorksheetFunction.Small(Arr, 3)) Then GoTo bb
                        If Not (d = Application.WorksheetFunction.Small(Arr, 4)) Then GoTo bb
                        If Not (e = Application.WorksheetFunction.Small(Arr, 5)) Then GoTo bb
                        If x = 65000 Then
                            x = 0
                            y = y + 1
                        End If
                        x = x + 1
                        Cells(x, y) = Join(Array(a, b, c, d, e), ",")
bb:
                         
                    Next
                Next
            Next
        Next
    Next
End Sub

[motilulla]

There was an error in my previous post so use this.

Sub Test()
End Sub

Excellent mdmackillop, it is working like magic

I am truly grateful to you for resolving my request it is 100% OK

Thank you very much for your kind help

Have a nice evening

Regards,
Moti