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]

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)
            If UBound(Split(Val, arr2(i))) = 1 Then
                x = x + 1
            End If
        Next i
        If x >= 3 Then
            Rows(r).Delete
        End If
        x = 0
        Val = ""
    Next r
    Application.ScreenUpdating = True
End Sub

 

[Osvaldo Palmeiro]

Another approach.

Sub DeleteRows()
 Dim r As Long
  Application.ScreenUpdating = False
  For r = Cells(Rows.Count, 1).End(3).Row To 1 Step -1
   If Evaluate("COUNTIF(" & Cells(r, 1).Resize(, 4).Address & ","">4"")") = 1 And _
    Evaluate("SUM(1/COUNTIF(" & Cells(r, 1).Resize(, 4).Address & "," & Cells(r, 1).Resize(, 4).Address & "))") = 4 Then Rows(r).Delete
  Next r
End Sub

 

[excelNewbie22]

thank you both
but none is working
both of them leaving me with
combo's of 1-1-2-3 or 1-1-3-4 or 1-1-3-2
and that's just from the start of a 4k lines/rows

the meanwhile i thought if i need to change the predefined numbers to something like 1-3-4-4 or 5-2-2-3?

any combo will include duplicate numbers like 3-4-4-5 or 1-4-4-6 or 5-2-2-7
so i know i wrote down

(without repeats of one the numbers like 8332=keep)

i take it back, cause i will need it to include even duplicate/repeated numbers like the the example above
and the ability to change the numbers ofcourse

sorry for the inconvenience and appreciate your help ?

 

[mumps]

Please post an updated data sample.

 

[excelNewbie22]

the red color is just to emphasis the combo's of 3's repeated/duplicated numbers from the predefined numbers
and yellow for emphasis the examples for the one's to keep

Copy.xlsx
	A	B	C	D	E	F
1	3	4	4	5	delete	for 1-2-3-4
2	1	4	4	6	delete	for 1-2-3-4
3	5	2	2	7	keep	for 1-2-3-4
4	1	1	2	3	delete	for 1-2-3-4
5	1	1	3	5	delete	for 1-2-3-4
6	8	3	1	1	delete	for 1-2-3-4
7	8	3	1	3	delete	for 1-2-3-4
8	1	1	3	6	delete	for 1-2-3-4
9	4	3	1	2	keep	for 2-3-5-5
10	5	3	1	5	delete	for 2-3-5-5
11	2	2	5	8	delete	for 2-3-5-5
copy

 

[Osvaldo Palmeiro]

I've split the predefined numbers from column F to G:J.

Pasta1
	A	B	C	D	E	F	G	H	I	J	K
1	3	4	4	5	delete	for 1-2-3-4	1	2	3	4
2	1	4	4	6	delete	for 1-2-3-4	1	2	3	4
3	5	2	2	7	keep	for 1-2-3-4	1	2	3	4
4	1	1	2	3	delete	for 1-2-3-4	1	2	3	4
5	1	1	3	5	delete	for 1-2-3-4	1	2	3	4
6	8	3	1	1	delete	for 1-2-3-4	1	2	3	4
7	8	3	1	3	delete	for 1-2-3-4	1	2	3	4
8	1	1	3	6	delete	for 1-2-3-4	1	2	3	4
9	4	3	1	2	keep	for 2-3-5-5	2	3	5	5
10	5	3	1	5	delete	for 2-3-5-5	2	3	5	5
11	2	2	5	8	delete	for 2-3-5-5	2	3	5	5
12
Plan1

Sub DeleteRowsV2()
 Dim r As Long
  Application.ScreenUpdating = False
  For r = Cells(Rows.Count, 1).End(3).Row To 1 Step -1
   If Evaluate("=SUMPRODUCT(COUNTIF(" & Cells(r, 1).Resize(, 4).Address & "," & Cells(r, 7).Resize(, 4).Address & "))") > 2 Then Rows(r).Delete
  Next r
End Sub

 

[excelNewbie22]

i don't understand
it's works for the sample i gave above
but when i run it in the big file=4k lines, it delete nothing!

also, i gave 2 predefined numbers (1234 and 2355) only to demonstrate what i need
(like combo's of 235 and 355 or 552 and so on)
the macro need to delete only combinations of one predefined numbers
which i need be able to change every time
and in this macro i don't understand how

not to even suggest what to do, but maybe with an array? (learned this term lately)
for me to manage and change

sorry if i'm troubling you guys with this nugget

 

[mumps]

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 + UBound(Split(Val, arr2(i)))
        Next i
        If x >= 3 Then
            Rows(r).Delete
        End If
        x = 0
        Val = ""
    Next r
    Application.ScreenUpdating = True
End Sub

 

[excelNewbie22]

work like a charm!
but when i tried change it, for example to : 5-5-3-4
in those 2 lines:

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

        Val = Join(Array(arr1(r, 5) & arr1(r, 5) & arr1(r, 3) & arr1(r, 4)), ",")

it returned an error saying: run time error 9 subscript out of range

can you please maybe fix it so i can change it to any 4 numbers without a hitch ?

edit:
debug coloring this line:

Val = Join(Array(arr1(r, 5) & arr1(r, 5) & arr1(r, 3) & arr1(r, 4)), ",")