generate 60 formations, but filtered from a minimum of zero and a maximum of 2 numbers

show at least two results - at least one which is OK and at least one which is not accepted (and comment why it cannot be accepted)

I think
1 2 10 11 12 13 14 15 16 17 18 19 20 21 22
fits your requirements
but may be I am wrong

Originally Posted by Kaper

show at least two results - at least one which is OK and at least one which is not accepted (and comment why it cannot be accepted)

in a workbook

The attachment from post #5 is not a valid file :-(

The code below would do.
It generates random combination of 15 out of 25. Then checks if any of 90 triplets is included as a whole. If not, it writes it to the workbook.
Then (as the combinations are randomly generated, there could be repeating combinations), duplicates are removed.
The macro stops after collecting 60 unique combinations of 15 numbers, none of them including any of the triplets.

Function generate_sorted_combination(how_many As Byte, from_set As Byte) As Variant
Dim arr_of_random As Variant, result_arr As Variant, i As Byte, j As Byte, threshold As Double
ReDim arr_of_random(1 To from_set)
ReDim result_arr(1 To how_many)
Randomize Time
For i = 1 To from_set
  arr_of_random(i) = Rnd
Next i
threshold = WorksheetFunction.Small(arr_of_random, how_many)
For i = 1 To from_set
  If arr_of_random(i) <= threshold Then
    j = j + 1
    result_arr(j) = i
  End If
Next i
generate_sorted_combination = result_arr
End Function

Function count_triplets(ByVal combination As Variant, a1, a2, a3) As Long
Dim i As Byte, counter As Byte
For i = 1 To UBound(combination)
  counter = counter + IIf(combination(i) = a1 Or combination(i) = a2 Or combination(i) = a3, 1, 0)
Next i
count_triplets = counter
End Function


Sub test()
Dim arr As Variant, triplets As Variant, i As Integer, j As Long, k As Byte
triplets = Range("A1:C90").Value
Do
  arr = generate_sorted_combination(15, 25)
'Debug.Print WorksheetFunction.CountIfs(arr, 2)
  k = 0
  For i = 1 To 90
    k = WorksheetFunction.Max(k, count_triplets(arr, triplets(i, 1), triplets(i, 2), triplets(i, 3)))
    If k > 2 Then Exit For
  Next i
  If k < 3 Then
    j = Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).Row
    Cells(j, "H").Resize(1, UBound(arr)) = arr
  End If
  If j >= 65 Then
    ActiveSheet.Range("$H$5:$V$65").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
      , 8, 9, 10, 11, 12, 13, 14, 15), Header:=xlYes
    j = Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).Row
  End If
Loop Until j >= 65

End Sub

If you just want to generate and then filter, you may use following code (recycled from one of my previous posts in excelforum.pl):

Sub generuj()
Dim ile As Long, poile As Integer, zilu As Integer, i As Long, j As Long, k As Integer
Dim intriplet As Long, liczba As Long, wyniki() As String, triplets As Variant, localmax As Long
ile = 60 'InputBox("ile losowań (max kilka tysięcy)")
poile = 15 ' InputBox("Po ile liczb")
zilu = 25 ' InputBox("Z ilu (49, 35 itp.)")
triplets = Range("A1:C90").Value
For i = 1 To ile
  ReDim Preserve wyniki(1 To ile)
  With CreateObject("System.Collections.ArrayList")
    Do
      liczba = WorksheetFunction.RandBetween(1, zilu)
      If Not .contains(liczba) Then .Add liczba
    Loop Until .Count = poile
   .Sort
   localmax = 0
   For j = 1 To 90
     intriplet = 0
     For k = 1 To 3
       intriplet = intriplet + IIf(.contains(CLng(triplets(j, k))), 1, 0)
     Next k
     localmax = WorksheetFunction.Max(localmax, intriplet)
   Next j
   wyniki(i) = Join(.toarray, ";") & ";" & localmax
  End With
Next i
Range("H6:W65").ClearContents
Range("H6").Resize(ile) = Application.Transpose(wyniki)
Range("H6:H65").TextToColumns Destination:=Range("H6"), DataType:=xlDelimited, Semicolon:=True
End Sub

I think your "every 5th or 6th draw" is too optimistic. In the attached file, there is the case (it happened to me at 4th run of the macro) where all 60 generated combinations had a triplet from 90 sample triplets. Of course it is not always like that.

The code was reused, so it contains some sub-optimal solutions.

instead of

For i = 1 To ile
  ReDim Preserve wyniki(1 To ile)

it would be better to reverse the sequence, and don't use Preserve so:

ReDim wyniki(1 To ile)
For i = 1 To ile