delete rows based on set of numbers (vba macro)

[excelNewbie22]

hi!
so i tried with watching videos in youtube, searching and testing for hours for several days, with no success
but i found a vba macro partly to my needs,
which is to delete ANY row without ANY or ALL the numbers i'll set (like 5 6 7 or more)
didn't manage to redefine the range (all rows in current sheet)
can you please help me out?

Sub DeleteRows()
' Defines variables
Dim Cell As Range, cRange As Range, LastRow As Long, x As Long


' Defines LastRow as the last row of data based on column A
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row


' Sets check range as A1 to the last row of A
Set cRange = Range("A1:A" & LastRow)

' For each cell in the check range, working from the bottom upwards
For x = cRange.Cells.Count To 1 Step -1
    With cRange.Cells(x)
        ' If the cell does not contain one of the listed values then...
        If .Value <> "5" And .Value <> "6" And .Value <> "7" Then
            ' Delete that row
            .EntireRow.Delete
        End If
    End With
' Check next cell, working upwards
Next x


End Sub

example:

567.xlsx
	A	B	C	D
6	1	1	2	7
7	1	1	2	8
8	1	1	3	2
9	1	1	3	3
10	1	1	3	4
11	1	1	3	5
12	1	1	3	6
13	1	1	3	7
14	1	1	3	8
15	1	1	4	2
16	1	1	4	3
17	1	1	4	4
18	1	1	4	5
19	1	1	4	6
20	1	1	4	7
21	1	1	4	8
22	1	1	5	2
23	1	1	5	3
24	1	1	5	4
25	1	1	5	5
26	1	1	5	6
27	1	1	5	8
28	1	1	6	2
29	1	1	6	3
30	1	1	6	4
31	1	1	6	5
32	1	1	6	6
33	1	1	6	7
34	1	1	6	8
35	1	1	7	2
567

 

[excelNewbie22]

still with numbers 5-6-7

and maybe i didn't explain myself too well:
i want the macro to delete any row (a1:d1, a2:d2.....a1000:d1000 and so on)
which doesn't have the numbers 5 or 6 or 7 even if there's other numbers in the same line
like:
1 2 3 5 - keep it
2 5 3 7 - keep it
1 2 3 8 - delete it -since there's no 5 or 6 or 7 in it

thanks for your patient

 

[Siddharth Rout]

still with numbers 5-6-7

and maybe i didn't explain myself too well:
i want the macro to delete any row (a1:d1, a2:d2.....a1000:d1000 and so on)
which doesn't have the numbers 5 or 6 or 7 even if there's other numbers in the same line
like:
1 2 3 5 - keep it
2 5 3 7 - keep it
1 2 3 8 - delete it -since there's no 5 or 6 or 7 in it

thanks for your patient

AH!

You want to check all 4 columns and not just Col A!

Is this what you are trying?

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    Dim arTemp As Variant
    Dim Exclude As Boolean
    Dim i As Long, j As Long, k As Long
    Dim DelRange As Range

    '~~> Change this to the relevant Sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")
 
    '~~> Change the dimension as required.
    '~~> Any number other than these will be deleted
    Dim ExcludeArray(1 To 3) As Variant
    ExcludeArray(1) = 5
    ExcludeArray(2) = 6
    ExcludeArray(3) = 7
 
    With ws
        .AutoFilterMode = False
   
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
       
        '~~> Store the entire range in an array
        arTemp = .Range("A1:D" & lRow).Value
       
        '~~> Loop through the array and clear rows in the array
        '~~> which doesn't have relevant numbers
        For i = LBound(arTemp) To UBound(arTemp)
            For j = 1 To 4
                For k = LBound(ExcludeArray) To UBound(ExcludeArray)
                    If arTemp(i, j) = ExcludeArray(k) Then
                        Exclude = True
                        Exit For
                    End If
                Next k
                If Exclude = True Then Exit For
            Next j
            If Exclude = False Then
                For k = 1 To 4: arTemp(i, k) = "": Next k
            Else
                Exclude = False
            End If
        Next i
       
        '~~> Write the array back to range
        .Range("A1:D" & lRow).Resize(UBound(arTemp), 4).Value = arTemp
       
        '~~> Find the new last row if appicable
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
       
        '~~> Identify blank rows and then delete those outside the loop in 1 go
        For i = 1 To lRow
            If Application.WorksheetFunction.CountA(.Range("A" & i & ":" & "D" & i)) = 0 Then
                If DelRange Is Nothing Then
                    Set DelRange = Range("A" & i & ":" & "D" & i)
                Else
                    Set DelRange = Union(DelRange, Range("A" & i & ":" & "D" & i))
                End If
            End If
        Next i
           
        If Not DelRange Is Nothing Then DelRange.Delete
    End With
End Sub

 

[excelNewbie22]

exactamundo!
kudos!
t-h-a-n-k-s!

 

[Siddharth Rout]

Thank You for the feedback