Deleting rows in Loop from list of names

[32CARDS]

Column A has listed items that are Accepted.
Column B has listed items that are not Accepted.

Column B is fixed set of items, but 1 or 2 new items from time to time may be added or deleted.

Column A though is a new updated daily list of items un-checked.

My current macro is a Do Until "" type of Loop to check if there are items to be deleted in Column A by reference to column B.
It then deletes that row.

Problem is, the macro is filling up with references as a new item is added.

Sub DelCustomRows2()
    Sheets("Sorted").Select
                [D3].Select
    Do Until ActiveCell.Value = ""
    If ActiveCell.Value = Sheets("CONTROLS").Range("V1").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V2").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V3").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V4").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V5").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V6").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V7").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V8").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V9").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V10").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V11").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V12").Value Then


    
    ActiveCell.EntireRow.Delete
    ActiveCell.Offset(-1, 0).Select
End If
ActiveCell.Offset(1, 0).Select
DoEvents
Loop
DoEvents
[A2].Select
Application.ScreenUpdating = True
End Sub

----------------------------------
Sheets("Sorted").Select
Sheets: Sorted is Column A, this is where the daily items are updated
--------
Sheets("CONTROLS").Range("V1").
Sheets CONTROLS is where the not wanted items are listed, fixed and updated manually from time to time as required.
---------

Each time a new "not wanted" item is added to the list, I have to
make adjustments to the macro

ActiveCell.Value = Sheets("CONTROLS").Range("V2").Value Or _
ActiveCell.Value = Sheets("CONTROLS").Range("V3").Value Or _
ActiveCell.Value = Sheets("CONTROLS").Range("V4").Value Or _


and so on.
----------
Question
Is there a better way to have a macro so whenever new not wanted items are added or removed,
the macro does not have to be amended each and every time ?

Thanks

 

[Michael M]

Might be easier with a sample set of data, but I'd suggest doing a countif formula. for example like

=IF(COUNTIF(A2:A10,B2)>0,1,"")

then autofilter and delete the rows with a 1

Can all be done with VBA and much faster.

 

[footoo]

The original post mentions columns A & B but the code posted is about looking for values in column D.
Based on the code posted (rather than the description :

Sub FT()
Dim cRay As Variant, sRay() As String, i%
With Sheets("Controls")
    cRay = .Range("V1:V" & .Cells(Rows.Count, "V").End(xlUp).Row)
End With
ReDim sRay(1 To UBound(cRay))
For i = 1 To UBound(cRay)
    sRay(i) = cRay(i, 1)
Next
With Sheets("Sorted")
    .[D2].AutoFilter Field:=1, Criteria1:=sRay, Operator:=xlFilterValues
    .Range("D3:D" & .Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .[D:D].AutoFilter
End With
End Sub

 

[32CARDS]

footoo

The original post mentions columns A & B but the code posted is about looking for values in column D.

It's part of another process-macro, it starts and finishes at D3 when the list is sorted.
If there is no new items ( empty new list), the other macro gives a msg then click and ends the process.

Must aways "land" on Sheets sorted D3 and never delete, or able to delete rows 1 & 2

However, your code worked great on test, Thank you.

but it will also delete the Rows 1 and 2 if Run again, on test.
It MUST not delete Rows 1 & 2 and MUST "land" on Cell D3 in Sheets sorted.
Because the other macro will also check if there is a empty or full list.

So, if no match, then end that macro.

 

[footoo]

.

 

[32CARDS]

=IF(COUNTIF(A2:A10,B2)>0,1,"")

Thanks Michael M
But I don't yet understand the "bigger picture" on how to implement your version.
I have to see the entire process.

Cheers

 

[footoo]

Sub FT()
Dim cRay As Variant, sRay() As String, i%, lr%
With Sheets("Controls")
    cRay = .Range("V1:V" & .Cells(Rows.Count, "V").End(xlUp).Row)
End With
ReDim sRay(1 To UBound(cRay))
For i = 1 To UBound(cRay)
    sRay(i) = cRay(i, 1)
Next
With Sheets("Sorted")
    .[D2].AutoFilter Field:=1, Criteria1:=sRay, Operator:=xlFilterValues
    lr = .Cells(Rows.Count, "D").End(xlUp).Row
    If lr < 3 Then
        GoTo e
    Else: .Range("D3:D" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
e:  .[D:D].AutoFilter
End With
End Sub

 

[32CARDS]

works good, had to add last bit of code at the end, so the next macro can start right at cell D3, it's fail_safe.

Sub FT_2()
Sheets("Sorted").Select
                [d3].Select
                
Dim cRay As Variant, sRay() As String, i%, lr%
With Sheets("Controls")
    cRay = .Range("V1:V" & .Cells(Rows.Count, "V").End(xlUp).Row)
End With
ReDim sRay(1 To UBound(cRay))
For i = 1 To UBound(cRay)
    sRay(i) = cRay(i, 1)
Next
With Sheets("Sorted")
    .[d2].AutoFilter Field:=1, Criteria1:=sRay, Operator:=xlFilterValues
    lr = .Cells(Rows.Count, "D").End(xlUp).Row
    If lr < 3 Then
        GoTo e
    Else: .Range("D3:D" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
e:  .[D:D].AutoFilter
End With


[B]Range("d1").Select
If Range("d1").Value >= 0 Then
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End If
[d2].Select
If Range("d2").Value >= 0 Then
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
End If
    [d3].Select
End Sub[/B]