macro deleting 3 out of 4 in any combo

[excelNewbie22]

hi

how can i delete all rows containing 3 out of 4 predefined numbers ?

for example, predefined numbers are:
1 2 3 4
and i want to delete any row containing any combo of 3 out of these 4 ?
like:
1235 or 4128 or 6341 and so on
(without repeats of one the numbers like 8332=keep)

1 2 3 7 delete
5 6 2 7 keep
5 2 1 3 delete
6 7 2 4 keep
1 3 5 2 delete
4 5 2 3 delete
2 2 1 5 keep
1 3 5 5 keep
8 3 3 2 keep

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

 

[mumps]

Don't duplicate the numbers in the variable aar2:

 arr2 = Array("5", "3", "4")

 

[excelNewbie22]

like my user name, i tried to understand and tried this:

arr2 = Array("5", "3", "4")
For r = UBound(arr1) To 1 Step -1
Val = Join(Array(arr1(r, 5) & arr1(r, 5) & arr1(r, 3) & arr1(r, 4)), ",")

but same error occurred

but also, and please forgive me at advanced but...
i rechecked my data and if the predefined numbers doesn't contain duplicates like 1-2-3-4
so i need the macro wouldn't delete lines with combinations of 3 numbers with duplicates like 1-2-2-5 or 3-4-7-3
but
when the predefined numbers contain some duplicate, like 5-5-4-3
i need the macro to delete only combo's of 3's containing the duplicate number (5 for this example) like 5-5-3-8 or 5-1-3-5
but won't delete combo's like 4-4-3-7 or 3-3-5-1

THANK YOU for bearing with me!

 

[excelNewbie22]

ok
so i understood how to change the macro
but still with the other problem i wrote in my last message?

 

[mumps]

Give this a try:

Sub deleteRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, arr1 As Variant, arr2 As Variant, r As Long, x As Long, i As Long, Val As String
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    arr1 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
    arr2 = Array("1", "2", "3", "4")
    For r = UBound(arr1) To 1 Step -1
        Val = Join(Array(arr1(r, 1) & arr1(r, 2) & arr1(r, 3) & arr1(r, 4)), ",")
        For i = LBound(arr2) To UBound(arr2)
            x = x + WorksheetFunction.CountIf(Range("A" & r).Resize(, 4), arr2(i))
        Next i
        If x >= 3 Then
            Rows(r).Delete
        End If
        x = 0
        Val = ""
    Next r
    Application.ScreenUpdating = True
End Sub

 

[excelNewbie22]

thanks but it's still delete the wrong lines
like: 1-1-1-1
1-1-1-2
2-4-5-4
and a lot more
maybe tell me how can i, if i can, help? maybe i don't explaining too well?

 

[mumps]

Let's try this one more time. Post updated data that contains examples of as many combinations as possible. It's hard to suggest a solution if we can't see what all the data looks like.

 

[excelNewbie22]

thanks for keep trying,
so, coulmn e is for predefined numbers 1-2-3-4 and any combo's of 3's need to delete
and any combo of 3's in this case which include a duplicate number from the set (1234) like 1-1-2-5 can't be deleted

and coumn f is for predefined numbers 5-5-4-3 and any combo's of 3's need to delete
but the thing with 5543 is there a duplicate number which is '5', so any combo of 3's in this case will allways include a '5'
(554x 5x53 x435 when x could be any number... and so on)

and maybe still use an array for me to able to change after if needs to?

y=keep
x=delete

p.s the original file only include numbers from a:d
and the macro should handle only one predefined numbers
and the above demonstrations are only for example ot two set's

abc.xlsx
	A	B	C	D	E	F
1	1	1	1	1	y	y
2	1	1	1	2	y	y
3	1	1	2	5	y	y
4	1	2	1	8	y	y
5	1	2	2	1	y	y
6	1	2	2	2	y	y
7	1	3	1	7	y	y
8	1	3	4	1	x	y
9	1	3	5	2	x	y
10	2	1	1	1	y	y
11	2	1	1	2	y	y
12	2	3	4	7	x	y
13	2	3	4	8	x	y
14	2	3	5	4	x	x
15	2	4	3	5	x	x
16	2	5	5	1	y	y
17	2	5	5	3	y	x
18	2	5	8	1	y	y
19	2	5	8	2	y	y
20	2	6	2	2	y	y
21	2	6	2	3	y	y
22	2	8	1	2	y	y
23	3	1	3	2	x	y
24	3	2	4	2	y	y
25	3	3	3	5	y	y
26	3	5	3	1	y	y
27	3	5	3	2	y	y
28	4	1	3	4	x	y
29	4	1	5	1	y	y
30	4	4	1	5	y	y
31	4	5	1	8	y	y
32	4	5	5	7	y	x
33	5	1	2	1	y	y
34	5	1	2	2	y	y
35	5	3	3	2	y	y
36	5	5	2	7	y	y
37	6	1	3	2	x	y
38	6	1	3	3	y	y
39	6	2	1	6	y	y
40	6	2	1	7	y	y
41	6	4	6	2	y	y
42	6	5	2	6	y	y
43	6	5	2	7	y	y
44	7	1	1	3	y	y
45	7	2	3	4	x	y
46	7	3	3	4	y	y
47	7	4	4	1	y	y
48	7	4	4	2	y	y
49	7	6	5	5	y	y
50	7	6	5	6	y	y
51	8	1	1	1	y	y
52	8	1	2	1	y	y
53	8	1	2	2	y	y
54	8	2	2	2	y	y
55	8	2	2	3	y	y
56	8	3	4	5	x	x
57	8	5	4	3	y	x
58	8	5	5	3	y	x
59	8	5	5	4	y	x
60	8	7	1	1	y	y
61	8	8	3	4	y	y
e-1234+f-5543

 

[mumps]

This should work for 1,2,3,4.

Sub deleteRows()
    Application.ScreenUpdating = False
    Dim arr1 As Variant, arr2 As Variant, r As Long, c As Long, i As Long
    arr1 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
    arr2 = Array("1", "2", "3", "4")
    With CreateObject("scripting.dictionary")
        For r = UBound(arr1) To 1 Step -1
            For c = 1 To UBound(arr1, 2)
                For i = LBound(arr2) To UBound(arr2)
                    If arr2(i) = CStr(arr1(r, c)) Then
                        If Not .exists(arr2(i)) Then
                            .Add arr2(i), Nothing
                        End If
                    End If
                Next i
            Next c
            If .Count = 3 Then
                Rows(r).Delete
            End If
            .RemoveAll
I couldn't get anything to work for 3,4,5,5.  What happens if you want to use 3,3,4,5?  I'll try again and if I get anything that works, I'll get back to you.

 

[excelNewbie22]

thank you for your persistence
the last macro missing something in the end?

compile error
expected end sub

 

[mumps]

Oops!

Sub deleteRows()
    Application.ScreenUpdating = False
    Dim arr1 As Variant, arr2 As Variant, r As Long, c As Long, i As Long
    arr1 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
    arr2 = Array("1", "2", "3", "4")
    With CreateObject("scripting.dictionary")
        For r = UBound(arr1) To 1 Step -1
            For c = 1 To UBound(arr1, 2)
                For i = LBound(arr2) To UBound(arr2)
                    If arr2(i) = CStr(arr1(r, c)) Then
                        If Not .exists(arr2(i)) Then
                            .Add arr2(i), Nothing
                        End If
                    End If
                Next i
            Next c
            If .Count = 3 Then
                Rows(r).Delete
            End If
            .RemoveAll
        Next r
    End With
    Application.ScreenUpdating = True
End Sub