Hello,

I´m trying to improve an given VBA which gives combination for "lottery" where i have 13 slots with 3 different symbols "1, X, 2". They have the given rule that max **6** can get symbol **1**, max **6** can get symbol **X, **and **5 **can get symbol **2**. I have uploaded the my excel file ready with the filter on slots 1,2, 3 & 4 are given the symbol **1. **But here is the part i want to improve. Even if i think the first 4 can get symbol **1, **i don´t want a combonination where all of them are **1** at the same time. I want max 3 of 4 can be symbol **1 **at the same time. For example:

1,1,1,x,x,x,2,2,2,x,1,2

1,1,2,1,x,x,2,2,2,x,1,2

1,x,1,1,x,x,1,x,2,2,1,1.

This example can never happend

1,1,1,1,x,x,1,x,2,2,1,x

I assume i should have a statement before the for loop where i tell that "j = 1, j = 2, j = 3 & j = 4 can´t be 1 att the same time, max 3 of them can be symbol **1.**

Is there someone who can help me, or at least give me a direction of somewhere i can teach.

I appreciate all help.

Here is my vba code

"Sub testing() Dim aOut, Dict

t = Timer

Set Dict = CreateObject("scripting.dictionary")

For i = 0 To WorksheetFunction.Power(3, 13)

i1 = i

s = ""

ReDim tel(2)

b = True

For j = 1 To 13

Select Case i1 Mod 3

Case 0: s = s & " 1": tel(0) = tel(0) + 1: If tel(0) > 6 Then b = False: Exit For

Case 1: s = s & " 2": tel(1) = tel(1) + 1: If tel(1) > 5 Then b = False: Exit For

Case 2: s = s & " X": tel(2) = tel(2) + 1: If tel(2) > 6 Then b = False: Exit For

End Select

i1 = i1 \ 3

Next

If b Then Dict(s) = Split(Mid(s, 2)) ': MsgBox "1"

If i Mod 100000 = 0 Then Application.StatusBar = Format(i, "#,###") & " " & Dict.Count & " " & s: DoEvents

Next

If Dict.Count Then

Arr = Dict.keys

ReDim aOut(1 To UBound(Arr) + 1, 0)

For i = 1 To Dict.Count

aOut(i, 0) = Arr(i - 1)

Next

With Range("A1")

If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False

.CurrentRegion.Offset(1).ClearContents

With .Resize(, 13)

.Formula = "=""'"" & column()"

.Value = .Value

End With

.Offset(1).Resize(Dict.Count, 13).Value = Application.Index(Dict.items, 0, 0)

.CurrentRegion.AutoFilter

End With

End If

MsgBox Dict.Count & vbLf & Timer - t

End Sub

"

Best regard,

Mr_404