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
Excel VBA Course - From Beginner to Expert
200+ Video Lessons
50+ Hours of Video
200+ Excel Guides
Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)
VBA Combination/Posibility problem with and "not equal/OR"
Discussion
Sorry but you haven't uploaded your file. Please edit your question to attach a representative Excel file using the Add Files... button and also select your VBA code and press the CODE button (so it's formatted on the page)
I'm not back at my PC for a couple of hours so can't see your file yet/ step through your code. Looks like you're aiming to display all possible "legal" combinations, right? There will be far fewer than 1,594,323 (3 to the power 13) conbinations so should be okay for Excel's 1,048,576 row maximum but hard readibg!
If you could upload a sample file (as John has asked) that will be a great help to us to be able to help you.
First, the confusing thing for me in your post is " i have 13 slots" but each of the examples in your post are only 12 characters.
I don't have the time to do a deep dive in your code, but when I tried to test it I discovered there are 7 undeclared variables: t, i, i1, s, b, j, & Arr. Also the 2 you have declared (Dim aOut, Dict) have not been assigned a type (Long, String, Date, Range, etc) so VBA treats them as the Variant type.
You haven't specified which Excel version you are using as that can put restrictions/limitaions on what is possible (ex: 365 can do things 2016 can't).
Answers
Mr_404*
I don't agree that - in a true lottery as you describe- the selection cannot start 1111. That feels like your human intuition saying "That could never happen!" but all combinations should be equally likely in a truly random lottery.
Nevertheless, to eliminate any (expanded) combinations starting 1111, I'd add a line within your For loop as below:
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
'check if first digits are all 1
If s = " 1 1 1 1" Then b = False: Exit For
i1 = i1 \ 3
NextAfter the first 4 digits have been generated, e.g. string s= " x l 2 1" (length 8), this new test checks if they're all 1 (i.e. if s is " 1 1 1 1".
After that, b is False and a new dictionary item is not created. You can verify the results via the filters.
If you just want to limit the first 3 to not being 111, change the test string to " 1 1 1".
For more flexibility, say if you wanted to limit the number of 1s to a maximum of 3 in the first 4 digits, you use this test instead:
'check if more than 3 of first 4 digits are 1
If Len(s) = 8 And Len(Replace(Left(s, 8), " 1", "")) <= 2 Then b = False: Exit For Here each " 1" is replaced by nothing, so if it starts 1111, the tested length is 0 and if there are 3 1s the length is 2. Either way, no new dictionary item is written for those cases.
Hope this makes sense and helps, If so, please remember to mark this Answer as Selected
* I don't think you are!