Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Help with Mr Doug Glancy Code - Snake Columns
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Help with Mr Doug Glancy Code - Snake Columns
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


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default Help with Mr Doug Glancy Code - Snake Columns
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" wrote in message
...
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




Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Help with Mr Doug Glancy Code - Snake Columns
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" <deitbe @ consumer dot org wrote in message
...
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" wrote in message
...
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






Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default Help with Mr Doug Glancy Code - Snake Columns
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

"Rashid Khan" wrote in message
...
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" <deitbe @ consumer dot org wrote in message
...
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" wrote in message
...
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








Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Help with Mr Doug Glancy Code - Snake Columns
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
"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
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

"Rashid Khan" wrote in message
...
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" <deitbe @ consumer dot org wrote in message
...
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" wrote in message
...
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










Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 691
Default Help with Mr Doug Glancy Code - Snake Columns
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
---
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

"Rashid Khan" wrote in message ...
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" <deitbe @ consumer dot org wrote in message
...
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" wrote in message
...
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








Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Help with Mr Doug Glancy Code - Snake Columns
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" wrote in message
...
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
---
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

"Rashid Khan" wrote in message
...
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" <deitbe @ consumer dot org wrote in message
...
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" wrote in message
...
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










Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Hide columns code jlclyde Excel Discussion (Misc queries) 0 April 25th 08 03:17 PM
Make Excel 2000 print long narrow list "snake" on wide paper? steve from mw rms rrd Excel Discussion (Misc queries) 2 March 1st 06 07:25 PM
Bernie, Dave, Doug, et. al. - question for you Ron M. Excel Discussion (Misc queries) 3 February 25th 06 11:57 PM
Help Required With Snake Column Rashid Khan Excel Programming 6 June 30th 04 02:37 PM
snake relocate to programmers :) Mark[_17_] Excel Programming 2 June 14th 04 08:41 AM


All times are GMT +1. The time now is 01:01 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement