Copy data to another sheet in sequential fashion

**jpkeller55** · 01-07-2005, 05:40 PM

I am hoping somebody can help me with this as I have not been able to find an answer.

On one sheet a user answers Y or N to as series of questions. I envision another sheet that would only list those rows that were answered N. I would like the summary of N's on the new sheet to be listed from row 1, 2, 3 etc...

Any ideas?

Thanks, Jim

**anilsolipuram** · 01-07-2005, 06:38 PM

try this macro

Sub Macro6()
Dim ini As Variant
Dim k, k1 As Variant

k = 1
k1 = 1
Sheets("sheet1").Select
Columns("C:C").Select
While ActiveCell.Address <> ini Or k = 2
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If ini <> ActiveCell.Address Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("a" & k1).Select
ActiveSheet.Paste
Sheets("sheet1").Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
k1 = k1 + 1
Wend
Range("a1").Select
Application.CutCopyMode = False
End Sub

**jpkeller55** · 01-09-2005, 11:15 AM

Thanks anilsolipuram, this is working exactly as I had envisioned!

How can I have this macro run automatically when the user goes to look at the other sheet?

Thanks, Jim

**anilsolipuram** · 01-10-2005, 05:13 PM

How can I have this macro run automatically when the user goes to look at the other sheet?

I think you mean other sheet is the sheet where sheet where summary of rows with N'S are displayed. i.e sheet2

paste the below code at tools->macro->visual basic editor,double click "sheet2 " below "microsoft excel objects"

Private Sub Worksheet_Activate()
Dim ini As Variant
Dim k, k1 As Variant

k = 1
k1 = 1
Sheets("sheet1").Select
Columns("C:C").Select
While ActiveCell.Address <> ini Or k = 2
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If ini <> ActiveCell.Address Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("a" & k1).Select
ActiveSheet.Paste
Sheets("sheet1").Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
k1 = k1 + 1
Wend
Range("a1").Select
Application.CutCopyMode = False

End Sub

**jpkeller55** · 01-10-2005, 06:23 PM

I have pasted the code as you have instructed. When I click on Sheet2, I get the error message:
Run-time error '1004'
Select method of Range class failed
Columns("C:C").Select

You have correctly identified what I am trying to do. The macro worked when I went to the TOOLS>MACRO and manually selected the macro and clicked on RUN.

It is almost there...Thanks!

**anilsolipuram** · 01-10-2005, 06:58 PM

I didnot test the code before posting.

Ignore my previous post.

Now, You already have the code for copying N's from sheet1 to sheet2

you need to call that code from "Worksheet_Activate" method of "sheet2" .

paste the below code at tools->macro->visual basic editor,double click "sheet2 " below "microsoft excel objects"

Dim i As Integer
Dim k As Integer

Private Sub Worksheet_Activate()

If k = 0 Then
k = 1
Call macro6
k = 0
End If

End Sub

now note that macro6 is the procedure already present in the module , if not present paste the below code in the module.

Public Sub macro6()
Dim ini As Variant
Dim k, K1 As Variant

k = 1
K1 = 1
Sheets("sheet1").Select
Columns("C:C").Select
While ActiveCell.Address <> ini Or k = 2
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If ini <> ActiveCell.Address Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("a" & K1).Select
ActiveSheet.Paste
Sheets("sheet1").Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
K1 = K1 + 1
Wend
Range("a1").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
End Sub

I did test it , it should work

**jpkeller55** · 01-10-2005, 07:22 PM

That seemed to do the trick.

One other question arises now. If the user goes back to sheet1 and changes some of the N's to Y's and then clicks on sheet2, I noticed that some of the old values from the first time still show up on sheet2 (i.e. if there were 25 lines of N on sheet2 origninally and the user changed 20 of those lines back to Y on sheet1 leaving only 5 N's, the macro copies the 5 lines but the remaining 20 on sheet2 are the ones from the original entry).

Is there a way to clear sheet2 if changes are made to sheet1?

Thanks...hopefully that will be my last question!

**anilsolipuram** · 01-10-2005, 07:25 PM

minor change in macro6 code in module

Public Sub macro6()
Dim ini As Variant
Dim k, K1 As Variant
Cells.Select
Selection.Delete
k = 1
K1 = 1
Sheets("sheet1").Select
Columns("C:C").Select
While ActiveCell.Address <> ini Or k = 2
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If ini <> ActiveCell.Address Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("a" & K1).Select
ActiveSheet.Paste
Sheets("sheet1").Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
K1 = K1 + 1
Wend
Range("a1").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
End Sub

**anilsolipuram** · 01-10-2005, 07:32 PM

Ignore my previous macro6 code

minor change to macro6 code in module

Public Sub macro6()
Dim ini As Variant
Dim k, K1 As Variant
Sheets("sheet2").Select
Cells.Select
Selection.Delete
k = 1
K1 = 1
Sheets("sheet1").Select
Columns("C:C").Select
While ActiveCell.Address <> ini Or k = 2
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If ini <> ActiveCell.Address Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("a" & K1).Select
ActiveSheet.Paste
Sheets("sheet1").Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
K1 = K1 + 1
Wend
Range("a1").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
End Sub

**jpkeller55** · 01-10-2005, 07:48 PM

That works. The only problem is: If all the rows have Y's on sheet1, then one would expect nothing to be copied to sheet2. If row C has all Y's, I get the following error message:

Run-time error '91'
Object variable or With block variable not set

**anilsolipuram** · 01-10-2005, 07:54 PM

error trapping code added to macro6 code

Public Sub macro6()
On Error GoTo a:
Dim ini As Variant
Dim k, K1 As Variant

Sheets("sheet2").Select
Cells.Select
Selection.Delete
k = 1
K1 = 1
Sheets("sheet1").Select
Columns("C:C").Select
While ActiveCell.Address <> ini Or k = 2
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If ini <> ActiveCell.Address Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("a" & K1).Select
ActiveSheet.Paste
Sheets("sheet1").Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
K1 = K1 + 1
Wend
a:
If k = 1 Then
MsgBox "No N's found in sheet1"
End If
Range("a1").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
Range("a1").Select
End Sub

**jpkeller55** · 01-10-2005, 07:58 PM

Beautiful!!

Thanks for your help...I appreciate your time and advice.

jpkeller55

**jpkeller55** · 01-11-2005, 01:39 PM

It seams I get more questions as I go further with this project. Here they are:

1) There are more than one sheet that a user will answer Y or N. These sheets are specific for different areas operation. Is there a way to compile all the N's on the summary sheet (i.e. N's from Sheet1, and Sheet2, and sheet3 to Sheet4)?

2) Instead of copying the whole row, can the macro copy just a certain range from each row? (i.e. just columns A thru C of each row)?

3) Can the paste function be set to paste the value's only and not the formating from Sheet1 etc?

Thanks for your expertise!

**anilsolipuram** · 01-11-2005, 02:50 PM

copy's N'S from sheet1 and sheet3 to sheet2, you can include in the array, names of sheets from where N's rows will be copied.

code is modified to copy column a:c instead of copying whole row.

code is modified to copy values not formating.

Public Sub macro6()
On Error GoTo a:
Dim ini As Variant
Dim k, K1 As Variant

Sheets("sheet2").Select
Cells.Select
Selection.Delete
k = 1
K1 = 1
ar = Array("sheet1", "sheet3")
For s = 0 To UBound(ar)
If s > 0 Then
K1 = K1 - 1
End If
Sheets(ar(s)).Select
Range("c1").Select
Columns("C:C").Select
k = 1
' K1 = 1
ini = ""
While ActiveCell.Address <> ini Or k = 2
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If ini <> ActiveCell.Address Then
Range("a" & ActiveCell.Row & ":c" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("a" & K1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets(ar(s)).Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
K1 = K1 + 1
Wend
a:
If k = 1 Then
'MsgBox "No N's found in sheet1"
End If
Next
Range("a1").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
Range("a1").Select
End Sub

**jpkeller55** · 01-11-2005, 04:11 PM

You are a wizard! Thanks!

**jpkeller55** · 01-11-2005, 05:36 PM

anilsolipuram,

Your help has been great. The application I am putting together is basically an audit form for our office. The different sheets cover different areas of operation. If the office is in compliance with a particular activity, it is scored a Y. If not in compliance, the score is a N. The non compliant activities are grouped in a sheet (sheet2) which will print only the noncompliant areas (action plan).

What I would like to do on the action plan sheet (sheet2) is have the first several rows labeled with data that will always be there (labels) and I would like the sheet to maintain it's format properties (cell width, lines, shading etc...). RIght now the functionality is working great except I believe the following lines in the macro is not only clearing the data but unfomatting the sheet as well.

Sheets("sheet2").Select
Cells.Select
Selection.Delete

Is there a way to only clear the data from sheet 2 (but keep the labels) when a change is made to the other sheets in the array and keep the formating on sheet2?

Thanks!!

**anilsolipuram** · 01-11-2005, 05:55 PM

use

Sheets("sheet2").Select
Cells.Select
Selection.ClearContents

instead of

Sheets("sheet2").Select
Cells.Select
Selection.Delete

**jpkeller55** · 01-11-2005, 06:03 PM

That works...except it is clearing the contents of row 1 and 2. I modified your macro so that the printing would start on row 3 of sheet using the following

Sheets("sheet2").Select
Cells.Select
Selection.ClearContents
k=1
k1=3

I would like to keep the labels that I have in Rows 1 and 2.

**anilsolipuram** · 01-11-2005, 06:25 PM

Rows("3:3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

this will clear contents from row3 and down

**jpkeller55** · 01-11-2005, 06:53 PM

Thank you - Thank you!!!

**jpkeller55** · 01-14-2005, 07:29 PM

anilsolipuram: If you are out there, I am having a problem with the macro: I have several sheets that the macro is looking for 'N' in column C. One of the sheets has several columns where the user answers Y or N. If the user puts N in columns, D,E,F for example, On sheet2 it is printing what is in column 3 times instead of once. Also, the macro seems to be picking up any cell that has an N in it instead of just looking at column C.

I cannot figure out why??
Public Sub macro6()

On Error GoTo a:
Dim ini As Variant
Dim k, K1 As Variant

Rows("7:7").Select
Range("a7:b7", Selection.End(xlDown)).Select
Selection.ClearContents
k = 1
K1 = 7
ar = Array("ADM", "PM", "CO", "NO", "WO", "PI", "GO", "CRR", "PRR")
For s = 0 To UBound(ar)
If s > 0 Then
K1 = K1 - 1
End If
Sheets(ar(s)).Select
Range("c1").Select
Columns("C:C").Select
k = 1
' K1 = 1
ini = ""
While ActiveCell.Address <> ini Or k = 2
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If ini <> ActiveCell.Address Then
Range("b" & ActiveCell.Row & ":b" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("b" & K1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets(ar(s)).Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
K1 = K1 + 1
Wend
a:
If k = 1 Then
'MsgBox "No N's found in sheet1"
End If
Next
Range("a1").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
Range("a1").Select
End Sub

**anilsolipuram** · 01-14-2005, 08:15 PM

try this macro

Public Sub macro6()

'On Error GoTo a:
Dim ini As Variant
Dim k, K1 As Variant

Rows("7:7").Select
Range("a7:b7", Selection.End(xlDown)).Select
Selection.ClearContents
k = 1
K1 = 7
ar = Array("ADM", "PM", "CO", "NO", "WO", "PI", "GO", "CRR", "PRR")
For s = 0 To UBound(ar)
If s > 0 Then
K1 = K1 - 1
End If
Sheets(ar(s)).Select
Range("c1").Select
Columns("C:C").Select
k = 1
' K1 = 1
ini = ""
While ActiveCell.Address <> ini Or k = 2
On Error Resume Next
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
'MsgBox Err.Description
If Err.Description <> "" Then
'MsgBox Err.Description
Err.Clear
GoTo a:
Else
If ini <> ActiveCell.Address Then
Range("b" & ActiveCell.Row & ":b" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("b" & K1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets(ar(s)).Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
K1 = K1 + 1
'MsgBox K1
End If
Wend
a:
If k = 1 Then
'MsgBox "No N's found in sheet1"
End If
Next
Range("a1").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
Range("a1").Select
End Sub

**jpkeller55** · 01-15-2005, 05:40 PM

Still not working. If I have a N in more than column C on any of the source sheets, it is printing on Sheet2 multiple times. For example: on one sheet I have 10 columns (D thru M) that the user answers Y or N. Column C has an IF/THEN statement to return an N if any of the cells in D thru M are N. Problem: Summary Sheet (sheet2) is duplicating the information from cell B the exact number that equals the number of N's in C thru M.

**anilsolipuram** · 01-15-2005, 10:11 PM

Can you paste your complete code

**jpkeller55** · 01-16-2005, 06:28 PM

On sheet2, the following code is attached:

Dim i As Integer
Dim k As Integer

Private Sub Worksheet_Activate()

If k = 0 Then
k = 1
Call macro6
k = 0
End If

End Sub

Module1 equals:

Public Sub macro6()

'On Error GoTo a:
Dim ini As Variant
Dim k, K1 As Variant

Rows("7:7").Select
Range("a7:b7", Selection.End(xlDown)).Select
Selection.ClearContents
k = 1
K1 = 7
ar = Array("ADM", "PM", "CO", "NO", "WO", "PI", "GO", "CRR", "PRR")
For s = 0 To UBound(ar)
If s > 0 Then
K1 = K1 - 1
End If
Sheets(ar(s)).Select
Range("c1").Select
Columns("C:C").Select
k = 1
' K1 = 1
ini = ""
While ActiveCell.Address <> ini Or k = 2
On Error Resume Next
Selection.Find(What:="N", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
'MsgBox Err.Description
If Err.Description <> "" Then
'MsgBox Err.Description
Err.Clear
GoTo a:
Else
If ini <> ActiveCell.Address Then
Range("b" & ActiveCell.Row & ":b" & ActiveCell.Row).Copy
Sheets("sheet2").Select
Range("b" & K1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets(ar(s)).Select
End If
If k = 1 Then
ini = ActiveCell.Address
End If
k = k + 1
K1 = K1 + 1
'MsgBox K1
End If
Wend
a:
If k = 1 Then
'MsgBox "No N's found in sheet1"
End If
Next
Range("a1").Select
Application.CutCopyMode = False
Sheets("sheet2").Select
Range("a1").Select
End Sub