if cell contains specific text, copy whole row - vba

Question

I'm trying to create a macro that does this:
Check the values from a small list (I've used an array)
Go in a worksheet and for every row that contains one of the values of the array copy the entire row in another worksheet.
I've mixed other macros to create one but I got one problem, the macro check the value on the array and copies all the rows in my worksheet but every time it doesn't copy the first row found: ex, if row that contain "abl" are: 100,200 and 300, the macro just copy 200 and 300 ignoring 100.
This is my macro
Sub Test_339_1()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
Dim nam(1 To 7) As String, cel As Range, rng As Range
i = 1
Set rng = Worksheets("Ctr 339").Range("V4:V10")
For Each cel In rng
nam(i) = cel.Value
i = i + 1
Next cel
For i = 1 To 7
For Each cell In Sheets("FB03").Range("E:E")
If cell.Value = nam(i) Then
matchRow = cell.Row
Rows(matchRow & ":" & matchRow).Copy
Sheets("Test_macro").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("FB03").Select
End If
Next
Sheets("Test_macro").Select
Next i
Sheets("Test_macro").Select
On Error Resume Next
Range("A1:A50000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Answer 1

Try this refactored code:
Sub Test_339_1()
Dim nam(1 To 7) As String, cel As Range, lastrow As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
nam = Worksheets("Ctr 339").Range("V4:V10").Value
lastrow = Sheets("FB03").Cells(Sheets("FB03").Rows.Count, "E").End(xlUp).Row
For Each cell In Sheets("FB03").Range("E1:E" & lastrow)
For i = 1 To 7
If cell.Value = nam(i) Then
matchRow = cell.Row
Sheets("FB03").Rows(matchRow).Copy Sheets("Test_macro").Rows(Sheets("Test_macro").Cells(Sheets("Test_macro").Rows.Count, "E").End(xlUp).Row + 1)
Exit For
End If
Next i
Next cell
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
It should be quicker, It will not loop over 7 million times.

Answer 2

AutoFilter() should speed things up quite a bit:
Option Explicit
Sub Test_339_1()
Dim nam As Variant
nam = Application.Transpose(Worksheets("Ctr 339").Range("V4:V10").Value)
With Sheets("FB03")
With .Range("E1", .Cells(.Rows.Count, "E").End(xlUp))
.AutoFilter Field:=1, Criteria1:=nam, Operator:=xlFilterValues '<--| filter referenced range on its 3rd column (i.e. "State") with 1
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any filterd cells other than header
With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
.EntireRow.Copy Sheets("Test_macro").Cells(.Cells(1, 1).Row,1)
End With
End If
End With
.AutoFilterMode = False
End With
End Sub
you only need row 1 to be a header one, i.e. actual data to be filtered begin from row 2 downwards
also this pastes values in target sheet from cell A1 downwards without blank rows. Should original row sequence be respected, it can be done