PDA

View Full Version : Copy selected rows and summarise on new worksheet



dribblle
02-28-2008, 04:06 PM
Hi All


I have a spreadsheet with 5 worksheets called:
People 1
People 2
People 3
People 4
Summary


Each People x worksheet lists names (up to 200) and other details associated with each name. There is a column called Required in each People x worksheet which has either a Y or N as a means for flagging a name. The value in the Required column may change on a weekly basis. The number of rows where the Required column is "Y" may vary from 1 to many.

What I am try to do is summarise those rows from each People x worksheet (along with the worksheet title) where the column Required equals "Y", to the existing Summary worksheet which then applies formulas.

I have tried building upon the arcticle "Delete Rows Based on Column Criteria" in an attempt to select the required rows, and the post "Solved: Code help for pulling-up data from another worksheet", but have not had much success to date.

Any help or guidance would be greatly appreciated.

Bob Phillips
02-28-2008, 04:55 PM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim cell As Range
Dim sh As Worksheet

nextrow = 1
Worksheets("Summary").Cells.ClearContents

For Each sh In ActiveWorkbook.Worksheets

With sh

If Left$(.Name, 6) = "People" Then

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To iLastRow 'iLastRow to 1 Step -1

If .Cells(i, Required_Column_Number).Value Then

'change the number in Resize to the actual number of columns to copy
.Cells(i, "A").Resize(, 10).Copy Worksheets("Summary").Cells(nextrow, "B")
Worksheets("Summary").Cells(nextrow, "A").Value = .Name
nextrow = nextrow + 1
End If
Next i
End If
End With
End With

End Sub

dribblle
02-28-2008, 07:32 PM
Hi xld

Thanks for the fast reply.

A couple questions/points about the code you suggested.

The last End With should be a Next sh

Is TEST_COLUMN the reference to the column I am testing for the flag in? I have assumend it is and have set it to D which is the column heading.
What does the Required_Column_Number variable represent? Should this be 4 as it is the 4th column?

When I step through the script, it finds the first worksheet and iLastRow is set to 4 which is the number of columns not the last row which should be around 75.

The script then crashes at the line:
If .Cells(i, Required_Column_Number).Value Then
as I am not sure what Required_Column_Number should be?

Thanks for you help so far

Bob Phillips
02-29-2008, 01:40 AM
A couple questions/points about the code you suggested.

The last End With should be a Next sh

Sorry about the End With, I just rattled it off before going to bed last night.


Is TEST_COLUMN the reference to the column I am testing for the flag in? I have assumend it is and have set it to D which is the column heading.

It might be, but I usually use it as the key column, the columne that defines the data and where I can test for the data ending (some other column may have blanks in, and so not represent the whole of the data).[/quote]


What does the Required_Column_Number variable represent? Should this be 4 as it is the 4th column?

I tried to be as literal as I could there. You didn't say which column the Required flag was in, so I didn't know, so I tried to tell you to insert it in the code. For instance, if the Required flag is in column M, that is 13 or "M", either works.


When I step through the script, it finds the first worksheet and iLastRow is set to 4 which is the number of columns not the last row which should be around 75.

That must be a coincidence. If you use the correct key column, it will get the last row.


The script then crashes at the line:
If .Cells(i, Required_Column_Number).Value Then
as I am not sure what Required_Column_Number should be?

Another slip-up, it should test for "Y".



Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Const Required_Column_Number As String = "M" ' <=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim NextRow As Long
Dim cell As Range
Dim sh As Worksheet

NextRow = 1
Worksheets("Summary").Cells.ClearContents

For Each sh In ActiveWorkbook.Worksheets

With sh

If Left$(.Name, 6) = "People" Then

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To iLastRow 'iLastRow to 1 Step -1

If .Cells(i, Required_Column_Number).Value = "Y" Then

'change the number in Resize to the actual number of columns to copy
.Cells(i, "A").Resize(, 10).Copy Worksheets("Summary").Cells(NextRow, "B")
Worksheets("Summary").Cells(NextRow, "A").Value = .Name
NextRow = NextRow + 1
End If
Next i
End If
End With
Next sh

End Sub