About Us

Doug Glancy

You're welcome!

Doug

"Jason Morin" wrote in message
...
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.Delete

End Sub

.

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Tech questions for Excel VBA programmer?	General Fear	Excel Discussion (Misc queries)	1	June 13th 07 11:22 PM
need an Excel VBA programmer	xjetjockey	Excel Discussion (Misc queries)	0	April 24th 07 09:56 PM
Freelance VBA/Excel programmer based in Shanghai	[email protected]	Excel Discussion (Misc queries)	5	February 11th 07 03:51 PM
Excel/VBA Freelance Programmer (based in Shanghai, China)	[email protected]	Excel Discussion (Misc queries)	1	February 9th 07 04:38 AM
Non programmer needs calculation help!!!!!	Malcolm	Excel Programming	4	February 4th 04 12:01 PM

Menu

About Us