Jason -

You're an engineer, so you'll be a better programmer than a "regular"
programmer. Your programs will do useful stuff, in ways that make sense
to its users.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
http://PeltierTech.com/Excel/Charts/
_______

Jason Morin wrote:

Great feedback, Doug. Thanks. But I'm not a
programmer...I'm an engineer. ;)


-----Original Message-----
Hey Jason,

Congratulations, you are a programmer! You wrote a

working macro and you've

identified some potential problems.

I've fiddled quite a bit with you're macro and tried to

document. I tend to

err on the side of long variable names so I can remember

what they mean, so

take that with a grain of salt. It looks like the empty

column takes care

of itself because of your end(xlup) statement. I put in

something for to

many rows and to delete any blank spaces that would

result from blank rows

in your original data. Also, deleted "AllData" if it

exists before starting

so you don't generate an error when you try to create it

again. A few other

things too, hopefully the comments are clear.

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

Dim from_lastcol As Long
Dim from_lastrow As Long
Dim to_lastrow As Long
Dim from_colndx As Long
Dim ws_from As Worksheet, ws_to As Worksheet

'turn off screen updating so runs faster/no flicker as

move between

worksheets
Application.ScreenUpdating = False
'turn off calculation so runs faster if you have

calculations in this sheet

Application.Calculation = xlCalculationManual

Set ws_from = ActiveWorkbook.ActiveSheet
from_lastcol = ws_from.Cells(1, Columns.Count).End

(xlToLeft).Column

'Turn error checking off so if no "AllData" trying to

delete doesn't

generate error
On Error Resume Next
'so not prompted to confirm delete
Application.DisplayAlerts = False
'Delete if already exists so don't get error
ActiveWorkbook.Worksheets("AllData").Delete
Application.DisplayAlerts = True
'turn error checking back on
On Error GoTo 0

'since you refer to "AllData" throughout
Set ws_to = Worksheets.Add
ws_to.Name = "AllData"

For from_colndx = 1 To from_lastcol
from_lastrow = ws_from.Cells(Rows.Count,

from_colndx).End(xlUp).Row

'If you're going to exceed 65536 rows
If from_lastrow + ws_to.Cells(Rows.Count, 1).End

(xlUp).Row <= 65536 Then

to_lastrow = ws_to.Cells(Rows.Count, 1).End

(xlUp).Row

Else
MsgBox "This time you've gone to far"
Exit Sub
End If
ws_from.Range(ws_from.Cells(1, from_colndx),

ws_from.Cells(from_lastrow,

from_colndx)).Copy ws_to.Cells(to_lastrow + 1, 1)
Next

' this deletes any blank rows
ws_to.Columns(1).SpecialCells

(xlCellTypeBlanks).EntireRow.Delete

'turn screen updating back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic 'ditto

calculation

End Sub

hth,

Doug

"Jason Morin" wrote in message
.. .

I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

Dim ilastcol As Long
Dim ilastrow As Long
Dim jlastrow As Long
Dim colndx As Long
Dim ws As Worksheet
Dim myrng As Range
Dim idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

Sheets("Alldata").Rows("1:1").EntireRow.Delet e

End Sub



.