Copy rows in Excel if cell contains name from an array

Question

I have an Excel sheet that contains entries for ~150 employees. Each row contains the name as well as hours worked, pay, team, etc etc etc etc. The B column in each row contains the employees name in Last,First format. About half the employees on the sheet are part time employees. What i'm trying to do is write a macro in VB that copies the entire row if the name in the B column matches one of the names of the part time employees so that one of my coworkers can simply run the macro and paste all of the rows of copied users into a new sheet each week. Here's what I currently have. (I have all of the employees names in the array however I have censored them out) I really don't understand much of the last 50% of the code. This stuff was stuff I found online and have been messing around with.

`Sub PartTime()
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean


nameArray = Array(NAMES CENSORED)

Set wsSource = ActiveSheet

NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add

For I = 1 To NoRows

    Set rngCells = wsSource.Range("C" & I & ":F" & I)
    Found = False
    For J = 0 To UBound(strArray)
        Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
    Next J

    If Found Then
        rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)

        DestNoRows = DestNoRows + 1
    End If
  Next I
End Sub`

Answer 1

This code should work for what you are looking for. It is important to note that the string names in your array must be identical to that in Column B (with the exception of leading and trailing spaces), so if the names are written "LastName, FirstName" then your input data must be identical. This code could be tweaked to not have this requirement, but for now I've left it as such. Let me know if you'd prefer the code be adjusted.

Option Explicit

Sub PartTimeEmployees()

Dim NewSheet As Worksheet, CurrentSheet As Worksheet, NameArray As Variant
Set CurrentSheet = ActiveWorkbook.ActiveSheet
Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count))
NewSheet.Name = "Part Time Employees"
NameArray = Array("NAMES CENSORED")

'Pulling headers from the first row
CurrentSheet.Rows(1).EntireRow.Copy
NewSheet.Select 'Redundant but helps avoid the occasional error
NewSheet.Cells(1, 1).Select
ActiveSheet.Paste
CurrentSheet.Select
Dim NextRow As Long
NextRow = 2

'Writing this code to not assume that the data is continuous
Dim Count As Long
'Iterating to the end of the data in the sheet
For Count = 2 To CurrentSheet.UsedRange.Rows.Count
    If Not IsEmpty(CurrentSheet.Cells(Count, 2)) Then
        For Counter = 1 To UBound(NameArray)
            'Performing string operations on the text will be faster than the find method
            'It is also essential that the names are entered identically in your array
            If UCase(Trim(CurrentSheet.Cells(Count, 2).Value)) = UCase(NameArray(Counter)) Then
                CurrentSheet.Rows(Count).Copy
                NewSheet.Select
                NewSheet.Cells(NextRow, 1).Select
                ActiveSheet.Paste
                CurrentSheet.Select
                NextRow = NextRow + 1
                Exit For
            End If
        Next Counter
    End If
Next Count

End Sub

Answer 2

No need to loop through the array if you use a Range.AutoFilter Method with the array as criteria.

See comment for each line of operational code.

Option Explicit

Sub partTimers()
    Dim nameArray  As Variant

    'construct an array of the part-time employees' names
    nameArray = Array("Trgh, Evtfk", "Mtre, Sdnrm", _
                      "Sfgd, Pxduj", "Lsds, Qwrml", _
                      "Eqrd, Oqtts")

    With Worksheets("Sheet1")   'you should know what worksheet the names are on
        'turn off AutoFilter is there is one already in operation
        If .AutoFilterMode Then .AutoFilterMode = False
        'use the 'island' of cells radiating out from A1
        With .Cells(1, 1).CurrentRegion
            'apply AutoFilter using array of names as criteria
            .AutoFilter field:=2, Criteria1:=nameArray, Operator:=xlFilterValues
            'check if there is anything to copy
            If Application.Subtotal(103, .Columns(2)) > 1 Then
                'copy the filtered range
                .Cells.Copy
                'create a new worksheet
                With .Parent.Parent.Worksheets.Add(After:=Sheets(Sheets.Count))
                    'paste the filtered range, column widths and cell formats
                    .Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
                    .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
                    .Cells(1, 1).PasteSpecial Paste:=xlPasteValues
                End With
            End If
        End With
        'turn off the AutoFilter
        If .AutoFilterMode Then .AutoFilterMode = False
        'turn off active copy range
        Application.CutCopyMode = False
    End With

End Sub