Help with Mr Doug Glancy Code - Snake Columns

[Rashid Khan]

Note: I had already posted it but no reply was received so I am reposting
under a different subject

Hello All,
I am using Office XP and the following macro was posted by Mr. Doug Glancy
to my previous question about Snake Columns. The macro works perfect but
every time I have to make a new Workbook

I wish to change this to work for Sheets in the same workbook. At present
it is working for only Sheet2 of a new Workbook only. I tried to change
Sheet3 Name to Sheet2 but it works only once. How can I amend it to work in
the same Sheet for other subsequent Sheets?

The macro should stop and ask for the new Sheet name prior to copying the
snake column.


Sub test()

Dim first_row As Long, last_row As Long

first_row = Selection.Rows(1).Row
last_row = first_row
While last_row < Selection.Rows(Selection.Rows.Count).Row
last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _
first_row).End(xlDown).Row, _
Selection.Rows(Selection.Rows.Count).Row)
Sheet1.Range("A" & first_row & ":A" & last_row).Copy _
Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Sheet1.Range("B" & first_row & ":B" & last_row).Copy _
Destination:=Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
first_row = last_row + 2
Wend

End Sub

 

[Bernie Deitrick]

Rashid,

This will work on the active sheet, and ask for the name of the destination
sheet. Note that there is no error checking on the input of the sheet name.

HTH,
Bernie
MS Excel MVP

Sub Test2()

Dim first_row As Long, last_row As Long

Dim mySheet As Worksheet
Dim myName As String

myName = InputBox("Enter the sheet name")
Set mySheet = Worksheets(myName)

first_row = Selection.Rows(1).Row
last_row = first_row
While last_row < Selection.Rows(Selection.Rows.Count).Row
last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _
first_row).End(xlDown).Row, _
Selection.Rows(Selection.Rows.Count).Row)
ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _
Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2)
ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _
Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2)
first_row = last_row + 2
Wend

End Sub

 

[Rashid Khan]

Hi Bernie,
It does not work for a single sheet also.
It gives the following error:
Run Time Error 9
Subscript out of range

What is missing?
Rashid

 

[Bernie Deitrick]

Rashid,

It will work for a single sheet. Are you typing in the sheet name
correctly? I have never received that error message.

HTH,
Bernie
MS Excel MVP

 

[David McRitchie]

You should be identifying the line that you get the error on,
but Subscript out of range is the type of error that you
would get for sheet not found. Make sure that you
have not introduced spaces at the end of the sheet name.
Do you have something that could be interpreted by
Excel as a number. By the way if you have a suggestion
you can supply a default sheetname to the
InputBox.

myName = TRIM(InputBox("Enter the sheet name", _
"supply sheetname", activesheet.name))
msgbox myname & "<-- verify"

InputBox and MsgBox
http://www.mvps.org/dmcritchie/excel/inputbox.htm

 

[Rashid Khan]

Hi Bernie,
Pardon me for my ignorance. Your code works if I supply the name viz.
Sheet2 or Sheet3, but what I required was to have the macro to ask the name
and then create the sheet with the new name supplied by me and copy the
matter on that sheet. Hope I am clear now.
Rashid Khan

 

[Rashid Khan]

Hello David,
I have copied the complete macro here for you to have a look.
It gives Run-time error '91' - Object variable or With block variable not
set.
It does not even copy the data on the Sheet2.

My requirement is to have the selection to be copied to the Sheet name
provided by me. The sheet should be created by the name which is supplied
in the Input Box.

Hope I am clear now.
Any help would be appreciated
Sub Test2()

Dim first_row As Long, last_row As Long

Dim mySheet As Worksheet
Dim myName As String
myName = Trim(InputBox("Enter the sheet name", _
"supply sheetname", ActiveSheet.Name))
MsgBox myName

first_row = Selection.Rows(1).Row
last_row = first_row
While last_row < Selection.Rows(Selection.Rows.Count).Row
last_row = Application.WorksheetFunction.Min(Sheet1.Range("A" & _
first_row).End(xlDown).Row, _
Selection.Rows(Selection.Rows.Count).Row)
ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _
Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2)
ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _
Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2)
first_row = last_row + 2
Wend

End Sub

 

[David McRitchie]

Hi Rashid,
It is a lot easier to help with code if we know what it is that it is supposed
to do. It appears that you want to:
unsnake columns A and B from the active sheet selection to your
chosen sheet.

Snakes coil up and use less space, you are unsnaking rather than
snaking. Actually maybe my choice of words in my snake.htm is
is not very practical because interpreted literally to have a column
reorganized to fit down one column on a page and then down the
next column on a page would not really be in the snake's best
interest as it would be chopped up to fit down each column.

If that is what you want then it works, but you must include the line
that was in Bernie's code; otherwide mySheet has no value.

As I said if you know where you want the default to be include it
in your inputbox. I don't know if activesheet is what you wanted,
your indicate it is not going to sheet2 -- if you want sheet2 to be the
default then use "Sheet2" including the quotes.

myName = Trim(InputBox("Enter the sheet name", _
"supply sheetname", ActiveSheet.Name))

'/* -- this line was in the code that Bernie had
Set mySheet = Worksheets(myName)

It would also be be wise to include the following at the top
of your macro:
Option Explicit

The other thing is from the title, it would appear that this is
some kind of continuation of another thread. That really
doesn't work out very well for anybody, since we don't know
what was in that thread or where Doug Glancy Code fits
in with this.

 

[Doug Glancy]

Rashid,

I believe this does what you want - allows you to name a new sheet to be
added and then unsnakes to that sheet. If you enter a duplicate sheet name
then you get a message and the macro exits. I hope this is what you want!

Sub Test2()

Dim first_row As Long, last_row As Long

Dim active_sheet As Worksheet
Dim mySheet As Worksheet
Dim myName As String
myName = Trim(InputBox("Enter the sheet name", _
"supply sheetname"))

Set active_sheet = ActiveSheet
Set mySheet = Worksheets.Add
On Error Resume Next
mySheet.Name = myName
If Err <> 0 Then
MsgBox "That sheet name already exists"
Application.DisplayAlerts = False
mySheet.Delete
Application.DisplayAlerts = True
Exit Sub
End If
On Error GoTo 0

active_sheet.Activate

first_row = Selection.Rows(1).Row
last_row = first_row
While last_row < Selection.Rows(Selection.Rows.Count).Row
last_row = Application.WorksheetFunction.Min(ActiveSheet.Range("A" & _
first_row).End(xlDown).Row, _
Selection.Rows(Selection.Rows.Count).Row)
ActiveSheet.Range("A" & first_row & ":A" & last_row).Copy _
Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2)
ActiveSheet.Range("B" & first_row & ":B" & last_row).Copy _
Destination:=mySheet.Range("A" & Rows.Count).End(xlUp)(2)
first_row = last_row + 2
Wend

mySheet.Activate

End Sub

hth,

Doug Glancy

 

[Rashid Khan]

Hello Doug,
It is perfect. Thanks a lot. Thats what I wanted.
Rashid Khan

 

[Rashid Khan]

Hello David,
Thanks a lot. I got the matter solved out by Mr Doug himself.
Your website is like the Alibaba Treasure for novice like me. It is a
wonderful site. Keep up the good work

Thanks for all your time and help
Rashid Khan

Hi Rashid,
It is a lot easier to help with code if we know what it is that it is supposed
to do. It appears that you want to:
unsnake columns A and B from the active sheet selection to your
chosen sheet.

Snakes coil up and use less space, you are unsnaking rather than
snaking. Actually maybe my choice of words in my snake.htm is
is not very practical because interpreted literally to have a column
reorganized to fit down one column on a page and then down the
next column on a page would not really be in the snake's best
interest as it would be chopped up to fit down each column.

If that is what you want then it works, but you must include the line
that was in Bernie's code; otherwide mySheet has no value.

As I said if you know where you want the default to be include it
in your inputbox. I don't know if activesheet is what you wanted,
your indicate it is not going to sheet2 -- if you want sheet2 to be the
default then use "Sheet2" including the quotes.

myName = Trim(InputBox("Enter the sheet name", _
"supply sheetname", ActiveSheet.Name))

'/* -- this line was in the code that Bernie had
Set mySheet = Worksheets(myName)

It would also be be wise to include the following at the top
of your macro:
Option Explicit

The other thing is from the title, it would appear that this is
some kind of continuation of another thread. That really
doesn't work out very well for anybody, since we don't know
what was in that thread or where Doug Glancy Code fits
in with this.

--
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm

Hello David,
I have copied the complete macro here for you to have a look.
It gives Run-time error '91' - Object variable or With block variable not
set.
It does not even copy the data on the Sheet2.