deleting entire rows if value is found in a list vba

Question

I have a list of around 200 names (on a sheet) that I need to try and filter (and delete) out of a data sheet. I'm struggling to get down how to set the list of names as an array so that I can filter that array under Range("E:E").AutoFilter Field:=1, Criteria1:=**Array Here**, _ and then later entirerow.delete.

This is my most recent attempt based off of other sources online, but it seems that most of them are lists that only contain 4-5 values, and I'm struggling to find anything that would be useful in putting all of the values in an array and filtering them based off of that, any help/workarounds are appreciated thank you!

Call myArrayRange
    Dim rng As Range
    Dim pos As Integer
    Dim arr As String
    Set arr = Worksheets("control").Range("K2:K10000")
    Set sht = ws
    With sht
        Range("E:E").AutoFilter Field:=1, Criteria1:=Array(""), _
                Operator:=xlFilterValues
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)
        rng.EntireRow.Delete
        .AutoFilterMode = False
    End With

End Sub
Sub myArrayRange()
lr = Worksheets("Control").Cells(Rows.Count, 11).End(xlUp).Row
Dim iAmount() As Variant
Dim iNum As Integer
iAmount = Range("K2:K" & lr)

For iNum = 1 To UBound(iAmount)
    Debug.Print iAmount(iNum, 1)
Next iNum

End Sub```

Answer 1

Delete Criteria Rows

Criteria

Table Before

Table After

The Code

• Carefully adjust the values in the constants section.

Option Explicit

Sub DeleteCriteriaRows()
    Const ProcName As String = "DeleteCriteriaRows"
    Dim RowsDeleted As Boolean
    Dim AnErrorOccurred As Boolean
    On Error GoTo ClearError ' enable error-handling routine
    
    ' Criteria
    Const cName As String = "Control"
    Const cFirstCellAddress As String = "K2"
    ' Table
    Const tName As String = "Data"
    Const tFirstCellAddress As String = "A2"
    Const tColumnIndex As Long = 5
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Criteria
    
    ' Reference the criteria worksheet.
    Dim cws As Worksheet: Set cws = wb.Worksheets(cName)
    
    ' Reference the criteria (one-column) range.
    Dim crg As Range: Set crg = RefColumn(cws.Range(cFirstCellAddress))
    
    ' Write the values from the criteria range
    ' to a 2D one-based one-column array.
    Dim cData As Variant: cData = GetRange(crg)
    
    ' Write the unique valeus from the array to a dictionary
    ' (exclude error values and blanks).
    Dim cDict As Object: Set cDict = DictColumn(cData)
    Erase cData ' data is in the dictionary
    
    ' Write the values from the dictionary, converted to strings,
    ' to a 1D zero-based string array.
    Dim csArr() As String: csArr = sArrDict(cDict)
    Set cDict = Nothing ' data is in the string array
    
    ' Table
    
    ' Reference the table worksheet.
    Dim tws As Worksheet: Set tws = wb.Worksheets(tName)
    
    Application.ScreenUpdating = False
    
    ' Clear all table worksheet's filters.
    If tws.FilterMode Then tws.ShowAllData
    
    ' Reference the table range (has headers).
    Dim trg As Range: Set trg = RefCurrentRegion(tws.Range(tFirstCellAddress))
    
    ' Reference the table data range (no headers).
    Dim tdrg As Range: Set tdrg = trg.Resize(trg.Rows.Count - 1).Offset(1)
    
    ' Apply the autofilter on the TABLE RANGE.
    trg.AutoFilter tColumnIndex, csArr, xlFilterValues
    
    ' Attempt to reference the filtered rows (the visible rows
    ' of the TABLE DATA RANGE).
    Dim tdfrg As Range
    On Error Resume Next ' defer error trapping
        Set tdfrg = tdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo ClearError ' re-enable error-handling routine
    
    ' Turn off the autofilter.
    tws.AutoFilterMode = False
    
    ' Delete the filtered rows.
    If Not tdfrg Is Nothing Then ' there are filtered rows...
        tdfrg.Delete xlShiftUp ' ... delete them
        RowsDeleted = True
    'Else ' there are no filtered rows; do nothing
    End If
    
ProcExit:
    On Error Resume Next
        If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
        ' Inform.
        If AnErrorOccurred Then
            MsgBox "An error occurred.", vbCritical, ProcName
        Else
            If RowsDeleted Then
                MsgBox "Filtered rows deleted.", vbInformation, ProcName
            Else
                MsgBox "No filtered rows.", vbExclamation, ProcName
            End If
        End If
    On Error GoTo 0
    
    Exit Sub
ClearError: ' Error-Handling Routine
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    AnErrorOccurred = True
    Resume ProcExit
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the one-column range ('crg') whose first
'               cell is defined by the first cell of the range ('FirstCell')
'               and whose last cell is the bottom-most non-empty cell
'               of the first cell's worksheet column.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefColumn( _
    ByVal FirstCell As Range) _
As Range
    Const ProcName As String = "RefColumn"
    On Error GoTo ClearError
    
    With FirstCell.Cells(1)
        Dim lCell As Range
        Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Function
        Set RefColumn = .Resize(lCell.Row - .Row + 1)
    End With

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the values of a range ('rg') in a 2D one-based array.
' Remarks:      If ˙rg` refers to a multi-range, only its first area
'               is considered.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRange( _
    ByVal rg As Range) _
As Variant
    Const ProcName As String = "GetRange"
    On Error GoTo ClearError
    
    If rg.Rows.Count + rg.Columns.Count = 2 Then ' one cell
        Dim Data As Variant: ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
        GetRange = Data
    Else ' multiple cells
        GetRange = rg.Value
    End If

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the unique values from a column ('ColumnIndex')
'               of a 2D array ('Data') in the keys of a dictionary.
' Remarks:      Error values and blanks are excluded.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function DictColumn( _
    ByVal Data As Variant, _
    Optional ByVal ColumnIndex As Variant) _
As Object
    Const ProcName As String = "DictColumn"
    On Error GoTo ClearError
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' case-insensitive
    
    Dim c As Long
    
    If IsMissing(ColumnIndex) Then
       c = LBound(Data, 2) ' use first column index
    Else
       c = CLng(ColumnIndex)
    End If
    
    Dim Key As Variant
    Dim r As Long
    
    For r = LBound(Data, 1) To UBound(Data, 1)
        Key = Data(r, c)
        If Not IsError(Key) Then ' exclude error values
            If Len(CStr(Key)) > 0 Then ' exclude blanks
                dict(Key) = Empty
            End If
        End If
    Next r
   
    If dict.Count = 0 Then Exit Function ' only error values and blanks
    
    Set DictColumn = dict

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Converts the values of the keys of a dictionary to strings
'               and returns the strings in a 1D zero-based string array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function sArrDict( _
    ByVal dict As Object) _
As String()
    Const ProcName As String = "sArrDict"
    On Error GoTo ClearError

    If dict.Count > 0 Then
        
        Dim sArr() As String: ReDim sArr(0 To dict.Count - 1)
    
        Dim Key As Variant
        Dim n As Long
        
        For Each Key In dict.Keys
            sArr(n) = CStr(Key)
            n = n + 1
        Next Key
        
        sArrDict = sArr
        
        Exit Function
    
    End If
    
ProcExit:
    ' Ensure a 1D zero-based string array is returned (no matter what).
    sArrDict = Split("") ' (LB=0, UB=-1)
        
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns a reference to the range starting with the first cell
'               of a range and ending with the last cell of the first cell's
'               Current Region.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefCurrentRegion( _
    ByVal FirstCell As Range) _
As Range
    Const ProcName As String = "RefCurrentRegion"
    On Error GoTo ClearError

    If FirstCell Is Nothing Then Exit Function
    With FirstCell.Cells(1).CurrentRegion
        Set RefCurrentRegion = FirstCell.Resize(.Row + .Rows.Count _
            - FirstCell.Row, .Column + .Columns.Count - FirstCell.Column)
    End With

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

Answer 2

EDIT: updated to match your actual use case.

Here's a basic example of how you can do it:

Sub Tester()
    
    Dim arr, rngNames as range, ws As Worksheet
    
    Set ws = ActiveSheet 'for example: the sheet with the data to filter
    
    With ws.Parent.Worksheets("Control")
        Set rngNames = .Range("K2:K" & .Cells(.Rows.Count, "K").End(xlUp))
    End With
    arr = RangeToArray(rngNames) 'get an array from the list of names

    ws.Range("E:E").AutoFilter Field:=1, Criteria1:=arr, _
                               Operator:=xlFilterValues
    ws.Autofilter.Range.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ws.AutoFilterMode = False
     
End Sub

'convert a range to a zero-based 1D array
Function RangeToArray(rng As Range)
    Dim r As Long, c As Long, arr, data, i
    data = rng.Value                    'get the source data
    ReDim arr(0 To rng.Cells.Count - 1) 'size the output array
    For r = 1 To UBound(data, 1)        'loop over the data from the range
        For c = 1 To UBound(data, 2)
            arr(i) = data(r, c)
            i = i + 1
        Next c
    Next r
    RangeToArray = arr
End Function

Answer 3

This is a really dangerous way to delete things. You can't really recover the data so make sure that filter works.

Sub Button1_Click()
    myArrayRange
End Sub

Sub myArrayRange()
    Dim rng As Range
    Dim pos As Integer
    Dim sht As Worksheet

    Set sht = ActiveSheet
    With sht
         'Your string array that holds names would go here VVVV (According to MS Docs)
         Range("E:E").AutoFilter Field:=1, Criteria1:=Array(""), _
            Operator:=xlFilterValues
         LstRw = .Cells(.Rows.Count, "A").End(xlDown).Row
         Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)
         rng.EntireRow.Delete
         .AutoFilterMode = False
    End With
End Sub

You'll have to find the sheet you need some way. I used the active sheet. Here's a screenshot of the data before and after.