Excel VBA copying rows that do not appear in two arrays and do not have a certain value

Question

I would like to copy only those rows, whose value in column 1 do not appear in two separate arrays and whose value in column 3 = 0.

For example, my data looks like this:

Name ID flag

Alice 1232 0

Alice 885  0

Alice 8332 1

Bob  993  1

Dan 9932  0

Chet 12  1

Fiona  993 0

Array1 = (Bob, Fiona)

Array2 = (Dan)

So I don't wanna copy Dan, Fiona and Bob. Of the remaining, only the first two entries of ALice have 0 in the third column, so I want to copy and paste to a new sheet

Name ID flag

Alice 1232 0

Alice 885  0

I would like to do an Autofilter but my Arrays have 2000 to 4000 elements in them and I cannot to a Array11 = (<>Bob, <>Fiona) and so on.

I have an array of all names , say ArrayAll = (Alice, Bob, Chet, Dan, Fiona) but I don't know how to do set theory operations that would subtract Array1 and Array2 from ArrayAll, short of doing two long loops which will be super slow.

Right now, instead of Filtering and copying, I am copying everything and then Autofiltering and deleting based on the two arrays and the third condition. The problem is that my code is super super super slow.

  Set wb1 = ActiveWorkbook
Set ws1 = wb1.Worksheets("SCL_FL")
'    strSearch = "SCL_FL"
           With ws1
               .AutoFilterMode = False
               lRow = .Range("A" & .Rows.Count).End(xlUp).Row
                With .UsedRange
            'Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
                    Set copyFrom = .EntireRow
               End With
              .AutoFilterMode = False
           End With
            Set ws3 = ActiveWorkbook.Worksheets.Add
            With ws3
               If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
                  lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
              Else
                  lRow = 1
              End If
              copyFrom.Copy .Range("A1")
             .Name = "Rest"
             .AutoFilterMode = False
             .UsedRange.AutoFilter Field:=2, Criteria1:=Array2()
             .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
             .AutoFilterMode = False
             .AutoFilterMode = False
             .UsedRange.AutoFilter Field:=2, Criteria1:=Array1()
             .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
             .AutoFilterMode = False
             .AutoFilterMode = False
             .UsedRange.AutoFilter Field:=Exceptions_Column, Criteria1:="1", Operator:=xlFilterValues
             .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
             .AutoFilterMode = False

           End With

Can someone please recommend a fast way to do this. Thank you!!

Answer 1

Amatya, if I understand correctly you want to improve the part which gets you all the results with 0s only.

In that case I suggest first copying the sheet and then filtering it like this

Option Explicit

Sub Main()
Application.ScreenUpdating = False
    AddWorksheet
    FilterResults
Application.ScreenUpdating = True
End Sub

Private Sub AddWorksheet()
    Sheets(1).Copy After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Working Copy"
End Sub

Private Sub FilterResults()
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long

    Set ws = ThisWorkbook.Sheets(Sheets.Count)
    lastRow = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
    Set rng = ws.Range("A1:C" & lastRow)

    ' filter and delete all but header row
    With rng
        .AutoFilter Field:=3, Criteria1:="<>0"
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    ws.AutoFilterMode = False
End Sub

In a new workbook I set up a sample data like this (on a Sheet1)

then ran the code and got a new sheet at the end called "Working Copy" with the following results

Note: to be fair, I do not know of a faster way to filter results. I created a new sheet instead of copy - pasting ranges which is much slower. Then applied the filter which removed all rows that their 3rd column ( column C ) is not equal to 0.

This run super fast < under 1 second but if you have more data then I understand it may be a bit slower - not much though :)

It took 1 second with 10,000 rows so it's still pretty fast