deleting rows with macro

[excelNewbie22]

hi!
how can i delete rows with multiple cells with specific values ?
example: i want to delete the rows (entirely) which contain only the numbers 1 and 4 and 9 ?

22.xlsx
	A	B	C	D	E
1	5	1	1	4	9
2	1	1	1	5	9
3	4	2	4	1	9
4	1	2	1	2	9
5	1	2	4	8	9
6	1	3	5	1	9
7	1	2	4	5	9
8	8	2	4	6	9
9	2	2	4	7	9
22

 

[JoeMo]

Not sure I understand exactly what you want. Assuming you want to delete entire rows containing 1 and 4 and 9, try this.

Sub RemoveRowsIf()
'removes entire rows containing Num1 and Num2 and Num3
'assumes data start in cell A1
Dim R As Range, V As Variant, i As Long, j As Long, Ct As Long, d As Object
Const Num1 As Long = 1: Const Num2 As Long = 4: Const Num3 As Long = 9   ' change Nums to suit
Set R = Range("A1").CurrentRegion
Set d = CreateObject("Scripting.dictionary")
V = R.Value
    For i = 1 To UBound(V, 1)
        For j = 1 To UBound(V, 2)
            If V(i, j) = Num1 Or V(i, j) = Num2 Or V(i, j) = Num3 Then
                If Not d.exists(V(i, j)) Then
                    d.Add V(i, j), ""
                    Ct = Ct + 1
                        If Ct = 3 Then
                            V(i, j) = "#N/A"
                            Ct = 0
                            d.RemoveAll
                            GoTo Nx
                        End If
                End If
            End If
        Next j
Nx:
    Next i
R.Value = V
On Error Resume Next
R.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0
End Sub

 

[excelNewbie22]

thank you!
perfect!

 

[Sahak]

Try this too

Sub Delete_Rows()
    Dim DelRow As Range
    For Each DelRow In Range("A1:A9")
       If Not IsError(Application.Match(1, Rows(DelRow.Row), 0)) And _
            Not IsError(Application.Match(4, Rows(DelRow.Row), 0)) And _
            Not IsError(Application.Match(9, Rows(DelRow.Row), 0)) Then
            DelRow.EntireRow.Delete
        End If
    Next
End Sub

 

[Joe4]

Try this too

Sub Delete_Rows()
    Dim DelRow As Range
    For Each DelRow In Range("A1:A9")
       If Not IsError(Application.Match(1, Rows(DelRow.Row), 0)) And _
            Not IsError(Application.Match(4, Rows(DelRow.Row), 0)) And _
            Not IsError(Application.Match(9, Rows(DelRow.Row), 0)) Then
            DelRow.EntireRow.Delete
        End If
    Next
End Sub

That will not work if you have consecutive rows that need deleting.

When deleting rows, you either:
- Need to wait and delete them all at once like JoeMo did.
or
- If deleting with each loop, you need to loop through your range backwards, so as not to miss any rows.

 

[Sahak]

Thank you, you are right.

 

[JoeMo]

thank you!
perfect!

You are welcome - thanks for the reply.

 

[JoeMo]

Thanks to excelNewbie22 for testing the code I posted in Post #2 and noting that for some of his data it doesn't produce the expected results. The problem was with the placement of two lines. I have corrected that below.

Sub RemoveRowsIf()
'removes entire rows containing Num1 and Num2 and Num3
'assumes data start in cell A1
Dim R As Range, V As Variant, i As Long, j As Long, Ct As Long, d As Object
Const Num1 As Long = 1: Const Num2 As Long = 5: Const Num3 As Long = 7   ' change Nums to suit
Set R = Range("A1").CurrentRegion
Set d = CreateObject("Scripting.dictionary")
V = R.Value
    For i = 1 To UBound(V, 1)
        For j = 1 To UBound(V, 2)
            If V(i, j) = Num1 Or V(i, j) = Num2 Or V(i, j) = Num3 Then
                If Not d.exists(V(i, j)) Then
                    d.Add V(i, j), ""
                    Ct = Ct + 1
                        If Ct = 3 Then
                            V(i, j) = "#N/A"
                            GoTo Nx
                        End If
                End If
            End If
        Next j
Nx: d.RemoveAll
    Ct = 0
    Next i
R.Value = V
On Error Resume Next
R.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
On Error GoTo 0
End Sub

 

[excelNewbie22]

thank you very much for effort and patient and of course the fix !

 

[JoeMo]

thank you very much for effort and patient and of course the fix !

You are welcome - thanks for the reply and the testing that uncovered the need for a fix.