adjusting a macro for delete rows with certain numbers only

[excelNewbie22]

hi!

i had a mistake (sorry) back then explaining this:

deleting rows with macro

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 ? ABCDE151149211159342419412129512489613519712459882469922479

www.mrexcel.com

(in here i use the numbers 1-4-9 but now i use others)

cause i need something slightly else, and i'll try to elaborate:

i need the macro to delete any lines/rows with the combination of 4 numbers (a1:d1, a2:d2 and etc) containing only the numbers 1-5-7 like 1577 or 7117 or 7115 or 7775,
but to keep lines with only part of them like 1572 or 1178 or 7558
so basically to delete lines containing only these numbers 1-5-7 and nothing else
if the line contains any other number then 1-5-7 it stays

sheet1
	A	B	C	D	E
1	1	1	4	6	keep
2	1	1	4	7	keep
3	1	1	4	8	keep
4	1	1	5	1	delete
5	1	1	5	2	keep
6	1	1	5	3	keep
7	1	1	5	4	keep
8	1	1	5	5	delete
9	1	2	5	7	keep
10	1	1	7	8	keep
11	7	5	5	8	keep
12	7	7	7	5	delete
13	5	1	7	7	delete
sheet1

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

 

[ranman256]

Sub DeleteMyRows()
'
Dim colNums As New Collection
Dim bBad As Boolean
Dim vNum
On Error GoTo ErrBad
'hold special numbers
colNums.Add "1", "1"
colNums.Add "5", "5"
colNums.Add "7", "7"

Range("A1").Select
Dim iRows As Long
iRows = ActiveSheet.UsedRange.Rows.Count
 'goto bottom
Cells(iRows, 1).Select
While ActiveCell.Row >= 1
  bBad = False
  ActiveCell.Offset(0, 1).Select
  While ActiveCell.Value <> "" And Not bBad
      vNum = ActiveCell.Value
      If colNums(CStr(vNum)) = CStr(vNum) Then
        Beep
      Else
        MsgBox "bad"
      End If
    
      ActiveCell.Offset(0, 1).Select  'next col
  Wend
  GoSub KillRow
skip:
    ActiveCell.Offset(-1, 0).Select  'prev row
   Cells(ActiveCell.Row, 1).Select
Wend
Exit Sub

KillRow:
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Delete
Return


ErrBad:
If Err = 5 Then  'dont delete
  Resume skip
Else
MsgBox Err.Description, , Err
End If
Exit Sub
Resume
End Sub

 

[excelNewbie22]

thank you ranman256,
but it is not working and it's returning an error

for the example above it's good
but for the full file, 4k lines, it does not
it's delete lines which shouldn't get deleted

 

[excelNewbie22]

for example it delete lines with
8-7-1-1
8-5-7-1
8-5-7-7
6-7-5-5

 

[Marc L]

Hi, according to Excel basics a VBA demonstration for starters :​

Sub Demo1()
      Const C = 4
        Dim N%(), R&
    With [A1].CurrentRegion.Resize(, C).Rows
            ReDim N(1 To .Count, 0)
        For R = 1 To .Count
            N(R, 0) = -(Application.Count(Application.Match(.Item(R), [{1,5,7}], 0)) = C)
        Next
            R = Application.Sum(N)
        If R Then
            Application.ScreenUpdating = False
           .Columns(C + 1).Value2 = N
           .Resize(, C + 1).Sort .Columns(C + 1), 1, Header:=2
            Union(.Columns(C + 1), .Item(.Count - R + 1 & ":" & .Count)).Clear
            Application.ScreenUpdating = True
        End If
    End With
End Sub

 

[excelNewbie22]

thank you marc!