Copy rows to new worksheet on condition

[IanMc]

Dear Excelsperts,

I haven't mucked about with Excel in quite a while now and have been asked to do a module in Excel 2000.

When given a workbook (tej-exit.xls) which has one worksheet of thousands of rows with columns from A to AS, i would like to copy all rows which have a zero in column N to a new worksheet.

Is this difficult?
Would i have to have one workbook with the code module in, load up the tej-exit.xls file ?

Thanks for any help

IanMc

[Paul B]

Try this
This Marco was modified to fit your needs, from one written by Barrie Davidson, you will need to change the range to fit, right now it is looking at Range("A1:AS3000"). Put this in a module in your workbook (tej-exit.xls). As always, make a backup before trying anything new
HTH
Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is a 0 in column N
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String

'Get the current file's name
CurrentFileName = ActiveWorkbook.Name
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS3000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = 0
'NOTE - this filter is on column N (field:=14), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=14, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
Workbooks.Add Template:="Workbook"
'Get this file's name
NewFileName = ActiveWorkbook.Name
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
Workbooks(CurrentFileName).Activate
'Clear the autofilter
Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
Range("A1").Select
Application.ScreenUpdating = True
End Sub

[IanMc]

Thanks Paul B !!!

I'll give it a whirl and let you know how i get on.

Is it also possible to have it in another blank workbook like 'code.xls' and then to 'import' the worksheet from the original?

Is it possible to get 'it' to do the importing?

Thanks muchly for your swift and knowledgeable help

IanMc

[Paul B]

you can put it your personal.xls workbook and it will be available in all workbooks

[IanMc]

Thanks again Paul,

What if i just want to add another worksheet with the results?

I've tried this so far:

Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is a 0 in column N
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String
'Dim FirstSheet As Long

'FirstSheet = Sheets(ActiveWorkSheet)
'Get the current file's name
CurrentFileName = ActiveWorkbook.Name
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS3000").Select

'Apply Autofilter
Selection.AutoFilter
FilterCriteria = 0
'NOTE - this filter is on column N (field:=14), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=14, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy

'Clear the autofilter
'
Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter

'Open a new worksheet 'file
Sheets.Add().Name = "Results"
Sheets("Results").Paste
'Get this file's name
'NewFileName = ActiveWorkbook.Name
'Make sure you are in cell A1
'ActiveSheet = "Results"
'Range("A1").Select
'Paste the copied cells
'ActiveSheet.Paste

'Go back to the original file
'Sheets(FirstSheet).Select

'Workbooks(CurrentFileName).Activate


'Clear the clipboard contents
Application.CutCopyMode = False
'Go to A1
Range("A1").Select
Application.ScreenUpdating = True
'Now make a worksheet with everything that is NOT zero in column N


UserForm1.Hide
End
End Sub


But it fails to paste the data,,, i don't have the VBA help files installed for my Excel yet (i've put in a request) so i'm a bit lost.

Thanks

Ian

[Paul B]

'this will put your data in a new worksheet
'it will also Auto fits text in Columns on the new sheet
Sub Extract_Data_Two()
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentsheetName As String
Dim NewFileName As String
'Get the current sheets's name
CurrentsheetName = ActiveSheet.Name
'Select the range
'(note you can change this to meet your requirements)
Range("A1:AS3000").Select
'Apply Autofilter
Selection.AutoFilter
'Get the filter's criteria from the user
FilterCriteria = 0
'Filter the data based on the user's input
'NOTE - this filter is on column N (field:=14), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=14, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
Sheets.Add
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
'Clear the clipboard contents
Application.CutCopyMode = False
' Auto fits text in Columns
Cells.Select
Selection.Columns.AutoFit
Range("A1").Select
'Go back to the original sheet
Worksheets(CurrentsheetName).Activate
'Clear the autofilter
Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
Range("A1").Select
Application.ScreenUpdating = True
End Sub

[IanMc]

Thanks Paul !! i shall give that a try,
Meanwhile thanks to your help i've managed to get it exactly as required in this instance.

The final subroutine (below) does the job.
The routine is activated by a button on the toolbar, (well actually this activates a nicely drawn UserForm with a picture, label and button on it, the button actually activates the subroutine)
The user first loads this Excel program with this in it and assigns a toolbar button to open the UserForm macro.

They then choose 'Open' and open the tej-exit.xls data file,
when the file opens all of the data apart from cell A1 is selected but this doesn't seem to matter,,, when they click on the toolbar button (which is a smiley) the UserForm opens and tells them what to do, they click on the button and the working is:
All rown with column N = zero are highlighted on the worksheet called tej-exit plus there has appeared a new worksheet called 'Results' which has only the rows in it with column N = zero
(it doesn't need for the first row to be headers or anything as it turns the filter back off)

The subroutine is here below, thank you very much indeed for your excellent help and i shall have a play with your latest version.

IanMc


Sub Extract_Data()
'this macro assumes that your first row of data is a header row.
'will copy a row from one worksheet, to another blank workbook
'IF there is a 0 in column N
'Variables used by the macro
Application.ScreenUpdating = False
Dim FilterCriteria
Dim CurrentFileName As String
Dim NewFileName As String

Set a = ActiveSheet
'Select Range
'(note you can change this to meet your requirements)
Range("A1:AS4000").Select
'Apply Autofilter
Selection.AutoFilter
FilterCriteria = 0
'NOTE - this filter is on column N (field:=14), to change
'to a different column you need to change the field number
Selection.AutoFilter field:=14, Criteria1:=FilterCriteria
'Select the visible cells (the filtered data)
Selection.SpecialCells(xlCellTypeVisible).Select
'Copy the cells
Selection.Copy
'Open a new file
'Workbooks.Add Template:="Workbook"
'Get this file's name
'NewFileName = ActiveWorkbook.Name
Sheets.Add().Name = "Results"
Set b = ActiveSheet
'Make sure you are in cell A1
Range("A1").Select
'Paste the copied cells
ActiveSheet.Paste
Range("A1").Select 'unselect everything
'Clear the clipboard contents
Application.CutCopyMode = False
'Go back to the original file
'Workbooks(CurrentFileName).Activate
a.Select
Selection.AutoFilter field:=14, Criteria1:=FilterCriteria
Selection.SpecialCells(xlCellTypeVisible).Select
'Clear the autofilter
'Selection.AutoFilter field:=1
'Take the Autofilter off
Selection.AutoFilter
'Go to A1
'Range("A1").Select
Application.ScreenUpdating = True
End
End Sub

[mlangen]

When I run this it only copies the header row into a newly created results worksheet?

Once I get this working it is exactly what I was looking for...

[mlangen]

Got it working

[sadi]

Thanks Paul,
but how can i protect my work book with morethan 5 sheet form another user. I can't run macro in protected workbook.

BR
sadi