VBA programmer feedback

J

Jason Morin

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
 
B

Bob Phillips

Hi Jason,

A couple of relatively minor points.

You use With to qualify an object, but for a single statement this has no
value, so

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

should be

Sheets.Add.Name = "Alldata"

Also, you set worksheet objects most of the time, but also use implicit
referencing, which, with the multiple sheets referenced, makes it more
difficult to follow than it need be.


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
T

Tom Ogilvy

It shouldn't work as written

One you add the sheet alldata, it is the active sheet. (and I don't see
anywhere that you change that)

but you set your range to copy with

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))

the unqualified Range and Cells refers to the activesheet.

you should have

Set myrng = ws.Range(ws.Cells(1, colndx), _
ws.Cells(ilastrow, colndx))
 
J

Jason Morin

Hi Bob-
Thanks for the feedback.
Jason
-----Original Message-----
Hi Jason,

A couple of relatively minor points.

You use With to qualify an object, but for a single statement this has no
value, so

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

should be

Sheets.Add.Name = "Alldata"

Also, you set worksheet objects most of the time, but also use implicit
referencing, which, with the multiple sheets referenced, makes it more
difficult to follow than it need be.


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)




.
Click to expand...
 
J

Jason Morin

Thanks for the feedback Tom. After I add "Alldata", I flip
back to the other sheet with

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

which probably isn't the most efficient or prettiest way.

Jason
 
D

Doug Glancy

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
 
J

Jon Peltier

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
 
B

Bob Phillips

Seeing as most programmers work from specs that are written by designers,
and are tested by a testing team, if the programs don't do useful stuff, or
it doesn't make sense to its users, that is not necessarily bad programming,
it is more likely to be down to bad design and/or bad testing.

Bob
 
D

Dave Peterson

You've got one more reply at your other post.

Jason said:
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
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Enhance sub to copy cols of variable length into 1 col to snake results into other cols 1
VBA - specify where data is placed on new sheet 5
reposting: combining multiple columns into one column - enhancements 1
Select data to imput to macro 1
subscript out of range.... 8
doesn't read all data from cells into xml file 2
Problem with exported text 5
problem with UsedRange 3

Top