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

 

[excelNewbie22]

sorry to say, after all your trying...
still no good
from the little bit i check,
it kept
4-1-2-3
4-2-3-1
4-2-1-3
and maybe more

 

[excelNewbie22]

can anyone please try and help me out? for summarize i'll copy in here the main problem:

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

range is always a:d for unknown numbers of rows
in here i'm writing two examples,
but the macro should handle only one example=predefined numbers:

example 1:
column e is for predefined numbers 1-2-3-4 and any combo's of 3 unique numbers need to be deleted
like 1-2-3-5 or 4-2-3-8 but not when one of the three is a duplicate one like 1-2-3-3

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

and maybe use an array for me to be able to change when needs to?

y=keep
x=delete

example.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	1	3	2	x	y
31	4	4	1	5	y	y
32	4	5	1	8	y	y
33	4	5	5	7	y	x
34	5	1	2	1	y	y
35	5	1	2	2	y	y
36	5	3	3	2	y	y
37	5	5	2	7	y	y
38	6	1	3	2	x	y
39	6	1	3	3	y	y
40	6	2	1	6	y	y
41	6	2	1	7	y	y
42	6	4	6	2	y	y
43	6	5	2	6	y	y
44	6	5	2	7	y	y
45	7	1	1	3	y	y
46	7	2	3	4	x	y
47	7	3	3	4	y	y
48	7	4	4	1	y	y
49	7	4	4	2	y	y
50	7	6	5	5	y	y
51	7	6	5	6	y	y
52	8	1	1	1	y	y
53	8	1	2	1	y	y
54	8	1	2	2	y	y
55	8	2	2	2	y	y
56	8	2	2	3	y	y
57	8	3	4	5	x	x
58	8	5	4	3	y	x
59	8	5	5	3	y	x
60	8	5	5	4	y	x
61	8	7	1	1	y	y
62	8	8	3	4	y	y
e-1234+f-5543

 

[mumps]

Try this version for any array of 4 numbers:

Sub deleteRows()
    Application.ScreenUpdating = False
    Dim arr1 As Variant, arr2 As Variant, r As Long, c As Long, i As Long, Val As String, Val2 As String
    arr1 = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
    arr2 = Array("3", "4", "5", "5")
    For r = UBound(arr1) To 1 Step -1
        Val = Join(Array(arr1(r, 1) & arr1(r, 2) & arr1(r, 3) & arr1(r, 4)), ",")
        Val2 = Join(Array(arr2(0) & arr2(1) & arr2(2) & arr2(3)), ",")
        If InStr(1, Val, arr2(0)) > 0 Then
            x = x + 1
        End If
        If InStr(1, Val, arr2(1)) > 0 Then
            x = x + 1
        End If
        If InStr(1, Val, arr2(2)) > 0 Then
            x = x + 1
        End If
        If InStr(1, Val, arr2(3)) > 0 Then
            x = x + 1
        End If
        If x >= 3 Then
            Rows(r).Delete
        End If
        x = 0
    Next r
    Application.ScreenUpdating = True
End Sub

 

[BSALV]

G = 1st question, like column E

Map1
	A	B	C	D	E	F	G
1	1	1	1	1	y	y	okay
2	1	1	1	2	y	y	okay
3	1	1	2	5	y	y	okay
4	1	2	1	8	y	y	okay
5	1	2	2	1	y	y	okay
Blad1

Cell Formulas
Range	Formula
G1:G5	G1	=IF((MAX(COUNTIF(A1:D1,{1;2;3;4}))>1)+(SUM(--(COUNTIF(A1:D1,{1;2;3;4})<>0))<3),"okay","delete")

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Blad1!$A$1:$M$62	G1

 

[BSALV]

i'm not sure if i understood the 2nd rule well.

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

Cell Formulas
Range	Formula
G1:G62	G1	=IF((MAX(COUNTIF(A1:D1,{1;2;3;4}))>1)+(SUM(--(COUNTIF(A1:D1,{1;2;3;4})<>0))<3),"okay","delete")
H1:H62	H1	=IF((COUNTIF(A1:D1,5)>1)+(SUM(--(COUNTIF(A1:D1,{3;4;5})<>0))<3),"okay","delete")

Named Ranges
Name	Refers To	Cells
_FilterDatabase	=Blad1!$A$1:$H$62	G1:H1

 

[Rick Rothstein]

I am pretty sure this macro will do what you want (just assign the numbers to check as a dash delimited string to the CheckMe variable)...

Sub DeleteIfThreeOutOfFour()
  Dim R As Long, X As Long
  Dim Arr As Variant, ArrChk As Variant
  Dim CheckMe As String, Combo As String
  
  CheckMe = "1-2-3-4"
  
  ArrChk = Split(CheckMe, "-")
  Arr = Range("A1", Cells(Rows.Count, "D").End(xlUp))
  For R = UBound(Arr) To 1 Step -1
    Combo = Join(Application.Index(Intersect(Rows(R), Columns("A:D")).Value, 1, 0), "")
    For X = 0 To 3
      Combo = WorksheetFunction.Substitute(Combo, ArrChk(X), "", 1)
    Next
    If Len(Combo) = 1 Then Rows(R).Delete
  Next
End Sub

 

[excelNewbie22]

mumps:
it was perfect for 1-2-3-4
but for 5-5-4-3
it deleted 1-4-4-5 because it had two '4' when it shouldn't, cause 4-4-5 isn't combo of 3's
only '5' in this predefined numbers need to be searched for duplicity and deleted

BSALV:
thank you, but i need a macro, and also it wasn't right as you can see for the example i gave

Rick Rothstein:
the macro kept the line 1-2-3-4 !!

 

[Rick Rothstein]

Rick Rothstein:
the macro kept the line 1-2-3-4 !!

Then I guess I don't understand your requirement. I thought you wanted only rows where 3 of the 4 numbers existed without repeats being counted twice. Is your actual requirement to delete rows where 3 or 4 numbers exist without repeats being counted twice? If so, then give this version a try...

Sub DeleteIfThreeOutOfFour()
  Dim R As Long, X As Long
  Dim Arr As Variant, ArrChk As Variant
  Dim CheckMe As String, Combo As String
 
  CheckMe = "1-2-3-4"
 
  ArrChk = Split(CheckMe, "-")
  Arr = Range("A1", Cells(Rows.Count, "D").End(xlUp))
  For R = UBound(Arr) To 1 Step -1
    Combo = Join(Application.Index(Intersect(Rows(R), Columns("A:D")).Value, 1, 0), "")
    For X = 0 To 3
      Combo = WorksheetFunction.Substitute(Combo, ArrChk(X), "", 1)
    Next
    If Len(Combo) <= 1 Then Rows(R).Delete
  Next
End Sub

 

[BSALV]

an adapted Rick-macro, but i see there were reactions, so ...

Sub DeleteIfThreeOutOfFour()
     Dim R As Long
     Dim Arr As Variant, ArrChk
     Dim CheckMe As String
     Dim iSmFr, iSm3, c, a, Most_Frequent, b

     CheckMe = "1-2-3-4"
     ArrChk = Split(CheckMe, "-")
    
     Set c = Range("A1", Cells(Rows.Count, "D").End(xlUp))
     Arr = c.Value

     For R = UBound(Arr) To 1 Step -1
          iSmFr = 9E+99                                         'very high value                               '
          a = Application.Index(Arr, R, 0)                      'take 1 row
          Most_Frequent = Application.Mode_Mult(a)              'values that are most frequent, as there are only 4, that's 1 or 2 duplicates
          If Not IsError(Most_Frequent) Then iSmFr = Application.Min(Most_Frequent)     'the smallest in case of 2
          iSm3 = Application.Small(a, 3)                        'the 3rd smallest value of the 4
          b = (iSmFr <= 4) Or (iSm3 > 4)                        'a duplicate<=4 or 3rd smallest >4 then it's okay
          If Not b Then c.Cells(R, 1).EntireRow.Interior.ColorIndex = 3        'tempory : mark row red instead of deleting
     Next
End Sub

 

[BSALV]

BSALV:
thank you, but i need a macro, and also it wasn't right as you can see for the example i gave

what part is wrong ?