Deleting rows in Loop from list of names

32CARDS

Board Regular
Joined
Jan 1, 2005
Messages
123
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.

Code:
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
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Might be easier with a sample set of data, but I'd suggest doing a countif formula. for example like

Code:
=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.
 
Upvote 0
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 :
Code:
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
 
Upvote 0
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.
 
Upvote 0
Code:
=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
 
Upvote 0
Code:
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
 
Upvote 0
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.

Code:
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]
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,016
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top