combine columns

[tombates]

I want to combine columns
1st column is
Tom
Dick
Harry

2nd column is
george
1
5

3rd column is
hhh
ajjas
jkajd

The result would be all spreadsheet data in one column
Tom
Dick
Harry
george
1
5
hhh
ajjas
jkajd

Mary

 

[Leith Ross]

Hello Tom,

This will combine data in the range of "A1:C25" ( you can change thi
to match your needs) and overwrite the data in column "A" as a singl
column.


Code
-------------------

Sub CombineColumns()

Dim Cell
Dim I As Long
Dim Rng As Range
Dim Temp()

ReDim Temp(0)
Set Rng = ActiveSheet.Range("A1:C25")

For Each Cell In Rng
I = I + 1
ReDim Preserve Temp(I)
Temp(I) = Cell
Next Cell

Rng.ClearContents
For I = 1 To UBound(Temp, 1)
ActiveSheet.Cells(I, "A").Value = Temp(I)
Next I

End Sub

-------------------

 

[Max]

Tried out your sub on the OP's data, Leith and I got:

Tom
george
hhh
Dick
1
ajjas
Harry
5
jkajd

But the OP wanted it as:

Tom
Dick
Harry
george
1
5
hhh
ajjas
jkajd

How could your sub be amended to provide the OP's result? Thanks.

 

[Dave Peterson]

This uses row 1 to determine how many columns to put at the bottom of column A.

Since it cleans up those other columns, test this against a copy of your data
(or close without saving):

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim RngToCopy As Range
Dim DestCell As Range
Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long

Set wks = Worksheets("sheet1")

With wks
FirstCol = 2
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For iCol = FirstCol To LastCol
Set RngToCopy = .Range(.Cells(1, iCol), _
.Cells(.Rows.Count, iCol).End(xlUp))
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)

DestCell.Resize(RngToCopy.Rows.Count, 1).Value _
= RngToCopy.Value
Next iCol

.Range(.Columns(FirstCol), .Columns(LastCol)).Delete

End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[tombates]

Thankyou
The procedure for combining the columns worked as you said. I might
also have blank cells within the range that is combined into the single
column. I need to maintain the value of those cells (empty) when the
columns are combined into one. How do you account for empty cells and
keep them as empty in the single column?
Mary

 

[Dave Peterson]

That code copies each column from row 1 to the last used cell in that column.

Can you specify a column that defines the last used row?

I used column A in my code:

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim RngToCopy As Range
Dim DestCell As Range
Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim LastRow as long

Set wks = Worksheets("sheet1")

With wks
lastrow = .cells(.rows.count,"A").end(xlup).row
FirstCol = 2
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For iCol = FirstCol To LastCol
Set RngToCopy = .Range(.Cells(1, iCol), _
.Cells(lastrow, iCol))
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)

DestCell.Resize(RngToCopy.Rows.Count, 1).Value _
= RngToCopy.Value
Next iCol

.Range(.Columns(FirstCol), .Columns(LastCol)).Delete

End With

End Sub

Change this line to what you need:
lastrow = .cells(.rows.count,"A").end(xlup).row
or even just plop in that value:
lastrow = 999

 

[tombates]

This works fine. What if lets say the 2nd column does not have
anything in the last row. I want for the routine to leave that cell
empty when it goes to the 1st column.
example:

a 1 10
b 2 12
c 3 aa
d 4 bb
e cc

should return
a
b
c
d
e
1
2
3
4

10
12
aa
bb
cc

Thanks for your help
Mary

 

[Dave Peterson]

Change this line:
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
to
Set DestCell = destcell.Offset(rngtocopy.rows.count)

 

[tombates]

I get
object variable or with block variable not set
and the routine stops

 

[Dave Peterson]

oops. I forgot to set it the first time:

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim RngToCopy As Range
Dim DestCell As Range
Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim LastRow as long

Set wks = Worksheets("sheet1")

With wks
lastrow = .cells(.rows.count,"A").end(xlup).row
FirstCol = 2
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

DestCell = .cells(lastrow+1,"A")

For iCol = FirstCol To LastCol
Set RngToCopy = .Range(.Cells(1, iCol), _
.Cells(lastrow, iCol))

DestCell.Resize(RngToCopy.Rows.Count, 1).Value _
= RngToCopy.Value

Set DestCell = destcell.offset(rngtocopy.rows.count)

Next iCol

.Range(.Columns(FirstCol), .Columns(LastCol)).Delete

End With

End Sub

 

[tombates]

I still get
object variable or with block variable not set
and the routine stops

 

[Dave Peterson]

Sorry, typo:

Set DestCell = .Cells(LastRow + 1, "A")

And if the code still doesn't work, please indicate the line that fails.

 

[tombates]

I have the routine working now, thank you

 

[tombates]

I have the routine working now, thank you

 

[Dave Peterson]

Sorry about the typos/lack of testing.

Glad you got it working.