VBA - Combine multiple columns into single column

[lj97]

G'day


I am needing to combine data from multiple columns into a single column.

The column name/header is in cell A1.

All data present needs to be in Column A.

I am needing each cell to only include one fruit name.

The data set is dynamic and changes regularly (i.e. sometimes there are more columns, sometimes there are less).

If anyone needs more info I am happy to provide it!

Thanks in advance

P.s. I have attempted a few things in VBA. I have gotten close, but I am stuck on what to do when there is only one entry in a column (e.g. column F having only "Apple" in this example).

Combine columns into single column.xlsm
	A	B	C	D	E	F
1	Fruit Name	Melon	Mango	Apple	Pear	Apple
2	Orange	Melon	Mango	Mango	Mango
3	Apple	Pear	Mango	Mango
4	Pear	Pear	Melon	Banana
5	Apple	Pear	Melon	Banana
6	Apple	Melon	Melon
7	Apple	Melon	Melon
8	Orange	Pear	Melon
9	Apple	Melon	Banana
10	Apple	Apple
11	Melon	Melon
12	Apple	Melon
13	Apple	Melon
14	Apple	Pear
15	Apple	Pear
16	Grapes	Pear
17	Apple	Melon
18	Apple	Melon
19	Apple	Banana
20	Orange	Banana
21	Apple	Banana
22	Apple	Melon
23	Apple	Melon
24	Apple	Melon
25	Apple	Pear
26	Apple	Melon
27	Apple	Apple
28	Apple
29	Apple
30	Apple
31	Apple
32	Apple
33	Apple
34	Orange
35	Apple
36	Apple
37	Orange
38	Apple
39	Grapes
40	Orange
41	Pear
Sheet1

 

[bebo021999]

There are six columns. Which are source columns and which is output column?

 

[Z51]

This might help...

Sub lj97()
Dim lastrow As Long, lastcol As Long, nextrow As Long, i As Long
lastcol = Range("A1").End(xlToRight).Column
nextrow = Range("A" & Rows.Count).End(xlUp).Row + 1

For i = 2 To lastcol
    lastrow = Cells(Rows.Count, i).End(xlUp).Row
    Cells(nextrow, 1).Resize(lastrow, 1).Value = Cells(1, i).Resize(lastrow, 1).Value
    nextrow = nextrow + lastrow
Next i
End Sub

 

[Peter_SSs]

You possibly do not have it yet but IF you happen to have the TOCOL function in your version, another way would be ..

Sub IntoOneColumn()
  With Range("A1").CurrentRegion
    .Resize(.SpecialCells(xlConstants).Count, 1).Value = Evaluate("=TOCOL(" & .Address & ",1,1)")
  End With
End Sub

 

[seniko]

Hello
Sorry. I am a new member. I would like to ask something...
I have the same problem in Excel 2007.
i would like a tocol function in vba but the above code doesn't work in my case...
Any idea????
I want the values of cells A1 to C8 (or 800 ex) of a table to be copied to a new column

 

[Peter_SSs]

Welcome to the MrExcel board!

Try something like this with a copy of your workbook.

Sub To_col()
  Dim c As Range
  
  For Each c In Range("A1:C8").Columns
    c.Copy Destination:=Range("F" & Rows.Count).End(xlUp).Offset(1)
  Next c
End Sub

 

[seniko]

Thank you!! I put it in vba but could you tell me the steps?? This code doesn't return any function...

 

[Peter_SSs]

I put it in vba

Where in vba? It should go in a standard module. Like this

Then in your worksheet area press Alt+F8, choose the To-col macro and click 'Run'.

Here is my sample data and the results of the code in column F

seniko.xlsm
	A	B	C	D	E	F
1	624	283	351
2	6	684	648			624
3	724	922	852			6
4	720	589	139			724
5	351	451	266			720
6	117	107	521			351
7	237	233	115			117
8	676	888	411			237
9						676
10						283
11						684
12						922
13						589
14						451
15						107
16						233
17						888
18						351
19						648
20						852
21						139
22						266
23						521
24						115
25						411
26
Sheet1

 

[seniko]

Thank you very much!! It works!! In column F only but -at least- it works!! I would like to have an option for the list to start in the cell I select and below, but that's fine too!!
Tnx!!!

 

[Peter_SSs]

I would like to have an option for the list to start in the cell I select and below

Select the starting cell for the results and then run this code.

Sub To_col_v2()
  Dim c As Range
  Dim lr As Long
  
  For Each c In Range("A1:C8").Columns
    lr = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
    If lr <= ActiveCell.Row Then lr = ActiveCell.Row - 1
    c.Copy Destination:=Cells(lr + 1, ActiveCell.Column)
  Next c
End Sub