Help Need VBA Code to copy rows to a new worksheet based on criteria

[goodeman]

This may have been posted already but I could not find anything that fit my wish.

I need a macro that will search data from a range of cells in one column for multiple criterias and them copy the entire rows to a new worksheet.

Example I have a list of group names

Network
Telcom
Help Desk
BA
Network

I only want to choose all Network and Telcom rows copy to another worksheet.

 

[Jon von der Heyden]

Hello and welcome to MrExcel.com

Are you only ever dealing with two criteria? If so copy this code to a new module and execute it with the data sheet activated / open. Change ranges to suite. Currently assumes data housed in column A and pastes it to Sheet2 starting at Range A1:

Sub NewSheetData()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Dim Rng As Range

Set Rng = Range([A1], Range("A" & Rows.Count).End(xlUp))

On Error Resume Next
    With Rng
        .AutoFilter , field:=1, Criteria1:="network", Operator:=xlOr, Criteria2:="telcom"
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Range("A1")
        .AutoFilter
    End With
On Error GoTo 0

Application.EnableEvents = True

End Sub

 

[philobr]

Hi Jon,
I think your code might help me solve my problem too.

http://www.mrexcel.com/forum/showthread.php?t=359730

My issue is that the Criteria is unknown until a selection is made from a Validation List.

I also have a second problem in that I need to have multiple selections specified by the user.
So using Goodemans example I could have 3 selections and the next time I might have 4.

Any ideas are greatly appreciated. You can see from my post I tried, but made a total mess.

Thanks

 

[goodeman]

WOW! Thanks. I do usally do about 10. Is is posible to do more that two? Thanks! You made my day!

 

[philobr]

Hi goodeman, so you are in the same position, you might not know which ones you need?

 

[Jon von der Heyden]

Hi

Here's one way. Loops through an array of criterion. You could also use advanced filter but I quite like this method. I learned this method from PeterSSs and now I use it regularly.

Sub NewSheetData()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Dim Rng As Range, arCrits(), l As Long

Set Rng = Range([A1], Range("A" & Rows.Count).End(xlUp))
arCrits = Array("network", "telcom") 'add more criteria to the array as required

For l = 0 To UBound(arCrits)
    On Error Resume Next
        With Rng
            .AutoFilter , field:=1, Criteria1:=arCrits(l)
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            .AutoFilter
        End With
    On Error GoTo 0
Next l

Application.EnableEvents = True

End Sub

 

[Colin Legg]

WOW! Thanks. I do usally do about 10. Is is posible to do more that two? Thanks! You made my day!

Which version of Excel are you using? You can do this in one go without looping in Excel 2007.

 

[philobr]

2003.
How can you do it without the loop in 2007?

 

[philobr]

Hi Jon,
What happens if you dont know the criteria before selecting:

arCrits = Array("network", "telcom") 'add more criteria to the array as required

Hi

Here's one way. Loops through an array of criterion. You could also use advanced filter but I quite like this method. I learned this method from PeterSSs and now I use it regularly.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> NewSheetData()<br><br><SPAN style="color:#00007F">With</SPAN> Application<br>****.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>****.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> Rng <SPAN style="color:#00007F">As</SPAN> Range, arCrits(), l <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><br><SPAN style="color:#00007F">Set</SPAN> Rng = Range([A1], Range("A" & Rows.Count).End(xlUp))<br>arCrits = Array("network", "telcom") <SPAN style="color:#007F00">'add more criteria to the array as required</SPAN><br><br><SPAN style="color:#00007F">For</SPAN> l = 0 <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(arCrits)<br>****<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>********<SPAN style="color:#00007F">With</SPAN> Rng<br>************.AutoFilter , field:=1, Criteria1:=arCrits(l)<br>************.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _<br>****************Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)<br>************.AutoFilter<br>********<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>****<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br><SPAN style="color:#00007F">Next</SPAN> l<br><br>Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[Jon von der Heyden]

Hello Philobr

Do you men that you don't want to "hard code" your criterion? That is, you want the ability to set it just before running the macro?

House a list of your criterion in a range and name it MyTable. Then this may help:

Sub NewSheetData()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Dim Rng As Range, rCell As Range

Set Rng = Range([A1], Range("A" & Rows.Count).End(xlUp))

For Each rCell In Range("MyTable")
    On Error Resume Next
        With Rng
            .AutoFilter , field:=1, Criteria1:=rCell.Value
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            .AutoFilter
        End With
    On Error GoTo 0
Next rCell

Application.EnableEvents = True

End Sub