VBA Help - .SpecialCells(xlConstants, xlLogical).EntireRow.Delete

[Mallesh23]

Hi Team,

I want to delete all rows where cells value <> "Keep" and <> "#N/A"
20000 rows want to delete. I used autofilter, loop, it worked,

Trying to learn new and multiple ways ....

Below code I got from this forum. its very fast
How to fit my requirement into below logic and delete entire row.

Sub Cobalt()
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("superseded", "inactive", "defunct")
   
   For i = 0 To UBound(Ary)
      Range("K:K").Replace Ary(i) & "*", True, xlWhole, , False, , False, False
   Next i
   Range("K:K").SpecialCells(xlConstants, xlLogical).EntireRow.Delete
End Sub

Below is dummy Column A.

Book5
	A	B
1	Data
2	Overdue	delete
3	Keep
4	Overdue	delete
5	#N/A
6	#N/A
7	#N/A
8	#N/A
9	Keep
10	Overdue	delete
11	#N/A
12	Paid	delete
13	Keep
14	#N/A
15	#N/A
16	Keep
17	Pending	delete
18	Keep
19	Keep
20	#N/A
Sheet1

Thanks
mg

 

[JoeMo]

Assuming there are no formulas in column A, try this:

Sub DeleteIf()
Dim V As Variant, i As Long
With Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
    V = .Value
    For i = 1 To UBound(V, 1)
        If IsError(V(i, 1)) Then GoTo Nx
        If V(i, 1) <> "Keep" Then V(i, 1) = True
Nx: Next i
    .Value = V
    Application.ScreenUpdating = False
    On Error Resume Next
        Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0
    Application.ScreenUpdating = True
End With

 

[Mallesh23]

Hi JoeMo,

Perfect ! it worked. thank.


Thanks
mg

 

[MARK858]

Trying to learn new and multiple ways ....

Seeing as you are just trying to learn new ways, another method below (should be slower than the code JoeMo posted).

Sub delNotarray()

    Dim rFnd As Range, rDel As Range
    Dim sAddr As String, vList As Variant, lCnt As Long

    Application.ScreenUpdating = False
   
    vList = VBA.Array("Keep", "#N/A")
   
    For lCnt = LBound(vList) To UBound(vList)
   
        With Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
            Set rFnd = .Find(vList(lCnt), , xlValues, xlWhole, xlByRows, xlNext, False)
           
            If Not rFnd Is Nothing Then
                If rDel Is Nothing Then
                    Set rDel = rFnd
                Else
                    Set rDel = Application.Union(rDel, rFnd)
                End If
               
                sAddr = rFnd.Address
                Set rFnd = .FindNext(After:=rFnd)
               
                Do Until rFnd.Address = sAddr
                    Set rDel = Application.Union(rDel, rFnd)
                    Set rFnd = .FindNext(After:=rFnd)
                Loop
            End If
        End With
    Next lCnt
    Columns(1).Insert
   
    If Not rDel Is Nothing Then rDel.Offset(, -1) = "xxx"
    Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(4).EntireRow.Delete
    Columns(1).Delete
    Application.ScreenUpdating = True

End Sub

 

[Mallesh23]

Hi Mark,

Thanks for sharing another option . it worked. ?

Thanks
mg

 

[JoeMo]

Hi JoeMo,

Perfect ! it worked. thank.


Thanks
mg

You are welcome- thanks for the reply.