Looking for Helps

[PAB]

Hi sss,

Thanks for the explanations , they make it more understandable.
I started again and merged your Macro into the Original Macro. After moving Code around a bit I came up with a new Macro ( Listed Below ). I ran it and it worked great . I checked the small output in a seperate SpreadSheet by applying formulas, and the results were ALL OK.
There is one small point though, when I ran your Macro it started putting the Combinations in Cell A1 onwards, now when I run the new Macro it starts putting the Combinations from Cell A2 onwards , I would prefer it to start in Cell A1.

Here is the new Macro :-

Option Explicit
Option Base 1
Public A As Integer
Public B As Integer
Public C As Integer
Public D As Integer
Public E As Integer
Public F As Integer

Dim N As Long
Dim nMinA As Integer
Dim nMaxF As Integer
Dim CriteriaColumns As Collection
Dim ColumnNumbers() As Integer
Dim TotalColumns As Integer
Dim ColumnCount() As Integer
Sub Combinations_649_A()
Dim ThisCriteria As Integer
Range("A1").Select
Application.ScreenUpdating = False
getCriteria
N = 1
Selection.ColumnWidth = 18
nMinA = 1
nMaxF = 16
For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF
If N = 65001 Then
Selection.ColumnWidth = 18
N = 1
ActiveCell.Offset(-65000, 1).Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
If SumAF Then
ThisCriteria = TestCriteria
If ThisCriteria = 321 Then
ActiveCell.Offset(1, 0).Select
N = N + 1
ActiveCell.Value = Application.WorksheetFunction.Text(A, "00") & "-" _
& Application.WorksheetFunction.Text(B, "00") & "-" _
& Application.WorksheetFunction.Text(C, "00") & "-" _
& Application.WorksheetFunction.Text(D, "00") & "-" _
& Application.WorksheetFunction.Text(E, "00") & "-" _
& Application.WorksheetFunction.Text(F, "00")
End If
End If
Next F
Next E
Next D
Next C
Next B
Next A
Application.ScreenUpdating = True
Set CriteriaColumns = Nothing
End Sub

Function SumAF()
SumAF = False
If A + B + C + D + E + F >= 21 And A + B + C + D + E + F <= 55 Then SumAF = True
End Function

Private Function TestCriteria() As Integer
Dim Done As Boolean
Dim i&, j&, Column&
Dim Arr(1 To 6) As Integer
Dim Ball As Integer
Dim Maximum As Integer
Dim strResult As String
Dim z As Variant

Arr(1) = A: Arr(2) = B: Arr(3) = C: Arr(4) = D: Arr(5) = E: Arr(6) = F

For Ball = 1 To 6
Done = False
For Column = 1 To TotalColumns
z = CriteriaColumns(Column)
j = UBound(z)
For i = 1 To j
If Arr(Ball) = z(i) Then
Done = True
Exit For
End If
Next
If Done Then Exit For
Next
ColumnCount(Column) = ColumnCount(Column) + 1
Next

strResult = ""
For i = 1 To TotalColumns
Maximum = -1
For j = 1 To TotalColumns
If ColumnCount(j) >= Maximum Then
Maximum = ColumnCount(j)
Ball = j
End If
Next
If Maximum > 0 Then strResult = strResult & Maximum
ColumnCount(Ball) = 0
Next

TestCriteria = CInt(strResult)

End Function

Private Sub getCriteria()
Dim col&, row&
Sheets("Group Criteria").Select
Set CriteriaColumns = New Collection
col = 1
Do While Trim(Cells(1, col)) <> ""
row = 1
ReDim ColumnNumbers(1)
Do While Trim(Cells(row, col)) <> ""
ReDim Preserve ColumnNumbers(row)
ColumnNumbers(row) = Cells(row, col)
row = row + 1
Loop
CriteriaColumns.Add ColumnNumbers
col = col + 1
Loop
TotalColumns = CriteriaColumns.Count
ReDim ColumnCount(TotalColumns)
Sheets("Combinations").Select
End Sub

I will play around trying out adding new Functions over the next couple of days.
Thanks again for all your efforts .

May the Force be with you
All the Best
PAB

 

[sss]

Hi sss,
new Macro it starts putting the Combinations from Cell A2 onwards , I would prefer it to start in Cell A1.

Hi PAB,
Change...
If ThisCriteria = 321 Then
ActiveCell.Offset(1, 0).Select
N = N + 1
ActiveCell.Value = Application.WorksheetFunction.Text(A, "00") & "-" _
& Application.WorksheetFunction.Text(B, "00") & "-" _
& Application.WorksheetFunction.Text(C, "00") & "-" _
& Application.WorksheetFunction.Text(D, "00") & "-" _
& Application.WorksheetFunction.Text(E, "00") & "-" _
& Application.WorksheetFunction.Text(F, "00")
End If

... to

If ThisCriteria = 321 Then
ActiveCell.Value = Application.WorksheetFunction.Text(A, "00") & "-" _
& Application.WorksheetFunction.Text(B, "00") & "-" _
& Application.WorksheetFunction.Text(C, "00") & "-" _
& Application.WorksheetFunction.Text(D, "00") & "-" _
& Application.WorksheetFunction.Text(E, "00") & "-" _
& Application.WorksheetFunction.Text(F, "00")
ActiveCell.Offset(1, 0).Select
N = N + 1
End If

... so that data is written to a current cell first, and then
position is changed.

For option to cancel generation that you mentioned before
you may use following: insert

If MsgBox("Click OK to continue or Cancel to interrupt", vbOKCancel, 65000 * (ActiveCell.Column - 1) & " combinations...") = vbCancel Then
Set CriteriaColumns = Nothing
End
End If

between lines

Application.ScreenUpdating = True
Application.ScreenUpdating = False

Now it will be:

Application.ScreenUpdating = True
If MsgBox("Click OK to continue or Cancel to interrupt", vbOKCancel, 65000 * (ActiveCell.Column - 1) & " combinations...") = vbCancel Then
Set CriteriaColumns = Nothing
End
End If
Application.ScreenUpdating = False

and you'll be asked for cancellation every time the entire column
is populated with results.

Good luck,
sss

 

[PAB]

Hi sss,

Thanks, the Combinations now Start at Cell A1.
Unfortunately the Message Box does NOT seem to be working. Also, it would be nice to have the Message Box Appear even if there is ONLY 1 Combination.

BTW, I forgot to ask you, do you play any other Lotto games other than KENO?.

Cheers
PAB

 

[sss]

Hi sss,

Thanks, the Combinations now Start at Cell A1.
Unfortunately the Message Box does NOT seem to be working. Also, it would be nice to have the Message Box Appear even if there is ONLY 1 Combination.

BTW, I forgot to ask you, do you play any other Lotto games other than KENO?.

Cheers
PAB

Hi PAB,

msgbox is triggered only when 65000 combos are written.
With parameters you're currently using you probably always
have less than 65K combos, and msgbox is not invoked.
You can move that chunk of code

If MsgBox("Click OK to continue or Cancel to interrupt", vbOKCancel, 65000 * (ActiveCell.Column - 1) & " combinations...") = vbCancel Then
Set CriteriaColumns = Nothing
End
End If

right after

ActiveCell.Value = Application.WorksheetFunction.Text(A, "00") & "-" _
& Application.WorksheetFunction.Text(B, "00") & "-" _
& Application.WorksheetFunction.Text(C, "00") & "-" _
& Application.WorksheetFunction.Text(D, "00") & "-" _
& Application.WorksheetFunction.Text(E, "00") & "-" _
& Application.WorksheetFunction.Text(F, "00")

This is OK for testing purposes. If however you run macro
against all 49 numbers, it's better to comment it out. Just
imagine how long would it take you to click 13 million times

Sometimes, not more than twice a week I also play Ontario 649
in addition to my favorite Keno. But don't ask me how I'm doing
sss

 

[PAB]

Hi sss,

As I have said before, it is normally when you DON'T have a good feeling about the numbers you are playing that they seem to Magically turn up a Prize ( however small ) . But as the saying goes, " You Have Got To Be In It To Win It " .

It is a shame that the Message Box cannot appear every time you Run the Macro, telling you how many Combinations have been produced, that way, if there are too many, you can cancel them being output to the WorkSheet thereby saving some time.

I want to be able to Set Criteria ( maybe Several ) for Last Digits, for example, I might decide that I ONLY want Combinations that have Two Numbers with the Last Digit of 1 or Three Numbers with the Last Digit of 3 etc.
I have Set-Up and Tested the Functions below which allow me to Set the Criteria myself. I assume that setting up Functions for this is the best way to go, as opposed to setting up an Array like for the Custom Grid.
What I am Basically asking you is, have I made these Functions more complicated than they need be. Is there a better way of Coding them :-

Option Explicit
Option Base 1
Public A As Integer
Public B As Integer
Public C As Integer
Public D As Integer
Public E As Integer
Public F As Integer
Dim N As Long
Dim nMinA As Integer
Dim nMaxF As Integer

Dim nLD0 As Integer
Dim nLD1 As Integer
Dim nLD2 As Integer
Dim nLD3 As Integer
Dim nLD4 As Integer
Dim nLD5 As Integer
Dim nLD6 As Integer
Dim nLD7 As Integer
Dim nLD8 As Integer
Dim nLD9 As Integer

Dim CriteriaColumns As Collection
Dim ColumnNumbers() As Integer
Dim TotalColumns As Integer
Dim ColumnCount() As Integer
Sub Test_Last()
Dim ThisCriteria As Integer
Range("A1").Select
Application.ScreenUpdating = False

nLD0 = 0
nLD1 = 1
nLD2 = 2
nLD3 = 3
nLD4 = 4
nLD5 = 5
nLD6 = 6
nLD7 = 7
nLD8 = 8
nLD9 = 9

getCriteria
N = 1
Selection.ColumnWidth = 18
nMinA = 1
nMaxF = 26
For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF
If N = 65001 Then
Selection.ColumnWidth = 18
N = 1
ActiveCell.Offset(-65000, 1).Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If

If SameLD1 = 2 Or SameLD2 = 3 Then

ThisCriteria = TestCriteria
' If ThisCriteria = 321 Then
ActiveCell.Value = Application.WorksheetFunction.Text(A, "00") & "-" _
& Application.WorksheetFunction.Text(B, "00") & "-" _
& Application.WorksheetFunction.Text(C, "00") & "-" _
& Application.WorksheetFunction.Text(D, "00") & "-" _
& Application.WorksheetFunction.Text(E, "00") & "-" _
& Application.WorksheetFunction.Text(F, "00")
ActiveCell.Offset(1, 0).Select
N = N + 1
End If
Next F
Next E
Next D
Next C
Next B
Next A
Application.ScreenUpdating = True
Set CriteriaColumns = Nothing
End Sub

Function SameLD0()
SameLD0 = 0
If A Mod 10 = nLD0 Then SameLD0 = SameLD0 + 1
If B Mod 10 = nLD0 Then SameLD0 = SameLD0 + 1
If C Mod 10 = nLD0 Then SameLD0 = SameLD0 + 1
If D Mod 10 = nLD0 Then SameLD0 = SameLD0 + 1
If E Mod 10 = nLD0 Then SameLD0 = SameLD0 + 1
If F Mod 10 = nLD0 Then SameLD0 = SameLD0 + 1
End Function

Function SameLD1()
SameLD1 = 0
If A Mod 10 = nLD1 Then SameLD1 = SameLD1 + 1
If B Mod 10 = nLD1 Then SameLD1 = SameLD1 + 1
If C Mod 10 = nLD1 Then SameLD1 = SameLD1 + 1
If D Mod 10 = nLD1 Then SameLD1 = SameLD1 + 1
If E Mod 10 = nLD1 Then SameLD1 = SameLD1 + 1
If F Mod 10 = nLD1 Then SameLD1 = SameLD1 + 1
End Function

*** DOWN TO... ***

Function SameLD9()
SameLD9 = 0
If A Mod 10 = nLD9 Then SameLD9 = SameLD9 + 1
If B Mod 10 = nLD9 Then SameLD9 = SameLD9 + 1
If C Mod 10 = nLD9 Then SameLD9 = SameLD9 + 1
If D Mod 10 = nLD9 Then SameLD9 = SameLD9 + 1
If E Mod 10 = nLD9 Then SameLD9 = SameLD9 + 1
If F Mod 10 = nLD9 Then SameLD9 = SameLD9 + 1
End Function

Private Function TestCriteria() As Integer

*** THE REST OF THE MACRO... ***

Thanks again sss.
PAB

 

[PAB]

Hi sss,

Have you had chance to have a look at the above.

Cheers
PAB

 

[sss]

Hi sss,

Have you had chance to have a look at the above.

Cheers
PAB

Hi PAB,
Your code is perfect, it's clear, easy to understand and works fine.
Generally speaking, there are two main criteria when we start thinking
about the code optimization after everything is tested and seems to be working
properly: one is performance (we need as fast code as possible), and another one
is thes size. Size of memory occupied by our code and/or data, size of the text
of a program itself, its readability, reusability etc.
Let's try to roughly estimate CPU's load for this macro:
in the worst scenario you may request your CPU to execute all SameLD0..SameLD9
10 functions foe every of 13mln lines (If SameLD1 = 2 Or SameLD2 = 3 ... Or SameLD9 = 3 Then...)
The CPU will perform 10 times the same operation A mod 10 (BTW, mod is quite slow operation),
10 times B mod 10, etc. Total 60 MODs per line (13mln lines total).
Also, each line calls a SameLDx function 10 times (function call is even worse in terms of time consuming)
Can we achieve the same with less MODs and less calls?
Let's think!
First step is to replace 10 SameLD functions with a single one with a parameter.

Function SameLD(byval Digit as integer)
SameLD = 0
If A Mod 10 = Digit Then SameLD = SameLD + 1
If B Mod 10 = Digit Then SameLD = SameLD + 1
If C Mod 10 = Digit Then SameLD = SameLD + 1
If D Mod 10 = Digit Then SameLD = SameLD + 1
If E Mod 10 = Digit Then SameLD = SameLD + 1
If F Mod 10 = Digit Then SameLD = SameLD + 1
End Function

This function will serve you as a SameLD1 when you passed parameter=1, as a SameLD2 when you passed parameter=2, etc.
Function call changes from
SameLD1/SameLD2/.../SameLD9

to

SameLD(1)/SameLD(2)/.../SameLD(9)

What did we improve? From the performance prospective - nothing:
still 10 function calls and 60 mods total. On the other hand, our
code become more compact and easy to maintain.

If we had an array SameLDArray defined in the Declaration section
dim SameLDArray(0 to 9) as integer

...instead of

Dim nLD0 As Integer
...
Dim nLD9 As Integer


... in that case we could use advantages of using arrays:

Function SameLD(byval Digit as integer)
dim ThisValue as integer

ThisValue=A mod 10
'if A=40 then ThisValue=0, so we we have to increment one of the SameLDArray's elements.
'And we know for sure which element - it is the element number "ThisValue", so:
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1

ThisValue=B mod 10
'if B=40 then ThisValue=0, so we we have to increment one of the SameLDArray's elements.
'And we know for sure which element - it is the element number "ThisValue", so:
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1

...
...
...

ThisValue=F mod 10
'if F=40 then ThisValue=0, so we we have to increment one of the SameLDArray's elements.
'And we know for sure which element - it is the element number "ThisValue", so:
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1

End Function


And as we can return result into the global SameLDArray, we can change our piece of code from being function to SUB
and instead of returning data to caller, we will write data directly to the global memory,
which is a SameLDArray array in our interpretation.


Sub SameLD()
ThisValue=A mod 10
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1
ThisValue=B mod 10
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1
ThisValue=C mod 10
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1
ThisValue=D mod 10
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1
ThisValue=E mod 10
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1
ThisValue=F mod 10
SameLDArray(ThisValue)=SameLDArray(ThisValue)+1
End sub


As a result, we have just one(!) call instead of 10, and total 6 mods instead of 60!


Finally, when you query a Last Digit status, you have now to change

"If SameLD1 = 2 Or SameLD2 = 3 Then"

to...

"if SameLDArray(1) = 2 or SameLDArray(2) =3 then..."

because the SameLDArray already has ALL data you need. Of course, if you didn't forget
to put
SameLD

before all checks

Good luck in hunting that ever elusive JP!
sss

 

[PAB]

Hi sss,

Brilliant .
Being a Newbie to VB, I expect I am going to do things the Long Handed way until I get some experience.
I am using the Function Method you Provided for Last Digits and it works Great.

One thing I did Notice though was that when I did a Query in the Form :-
If SameLD(1) = 3 And SameLD(2) = 2 And SameLD(3) = 1 Then
It took a Lot LONGER to Produce the Results than when I did :-
If SameLD(1) = 3 Then
If SameLD(2) = 2 Then
If SameLD(3) = 1 Then
I will stick to using the Later.

The only Other thing I want to do is with Regard to Decades. I want to be Able to Set-Up how Many Numbers I want Included from EACH Decade.
Decade 0 = 1 to 9
Decade 1 = 10 to 19
Decade 2 = 20 to 29
Decade 3 = 30 to 39
Decade 4 = 40 to 49
I have Set-Up the following which I have Tested and it Appears to work OK :-

Function SameDecade0()
SameDecade0 = 0
If A = 1 Or A = 2 Or A = 3 Or A = 4 Or A = 5 Or A = 6 Or A = 7 Or A = 8 Or A = 9 Then SameDecade0 = SameDecade0 + 1
If B = 1 Or B = 2 Or B = 3 Or B = 4 Or B = 5 Or B = 6 Or B = 7 Or B = 8 Or B = 9 Then SameDecade0 = SameDecade0 + 1
If C = 1 Or C = 2 Or C = 3 Or C = 4 Or C = 5 Or C = 6 Or C = 7 Or C = 8 Or C = 9 Then SameDecade0 = SameDecade0 + 1
If D = 1 Or D = 2 Or D = 3 Or D = 4 Or D = 5 Or D = 6 Or D = 7 Or D = 8 Or D = 9 Then SameDecade0 = SameDecade0 + 1
If E = 1 Or E = 2 Or E = 3 Or E = 4 Or E = 5 Or E = 6 Or E = 7 Or E = 8 Or E = 9 Then SameDecade0 = SameDecade0 + 1
If F = 1 Or F = 2 Or F = 3 Or F = 4 Or F = 5 Or F = 6 Or F = 7 Or F = 8 Or F = 9 Then SameDecade0 = SameDecade0 + 1
End Function

To

Function SameDecade4()
SameDecade4 = 0
If A = 40 Or A = 41 Or A = 42 Or A = 43 Or A = 44 Or A = 45 Or A = 46 Or A = 47 Or A = 48 Or A = 49 Then SameDecade4 = SameDecade4 + 1
If B = 40 Or B = 41 Or B = 42 Or B = 43 Or B = 44 Or B = 45 Or B = 46 Or B = 47 Or B = 48 Or B = 49 Then SameDecade4 = SameDecade4 + 1
If C = 40 Or C = 41 Or C = 42 Or C = 43 Or C = 44 Or C = 45 Or C = 46 Or C = 47 Or C = 48 Or C = 49 Then SameDecade4 = SameDecade4 + 1
If D = 40 Or D = 41 Or D = 42 Or D = 43 Or D = 44 Or D = 45 Or D = 46 Or D = 47 Or D = 48 Or D = 49 Then SameDecade4 = SameDecade4 + 1
If E = 40 Or E = 41 Or E = 42 Or E = 43 Or E = 44 Or E = 45 Or E = 46 Or E = 47 Or E = 48 Or E = 49 Then SameDecade4 = SameDecade4 + 1
If F = 40 Or F = 41 Or F = 42 Or F = 43 Or F = 44 Or F = 45 Or F = 46 Or F = 47 Or F = 48 Or F = 49 Then SameDecade4 = SameDecade4 + 1
End Function

With 5 Functions and 9 Lines to Each ( 45 Lines of Code ), I know that there is Probably a Far Easier way to do this.
What would you do to Make this a Far More Simpler and Compact Set of Functions?.
I Assume it could Probably be Done like the Last Digits using a Function Call ( Preferred ) OR by using a Sub.

Did you have Any Luck on the Keno?, or shouldn't I ask.

Thanks again sss
All the Best
PAB

 

[sss]

Hi sss,
PAB

Hi PAB,
Yes, in here...
If SameLD(1) = 3 And SameLD(2) = 2 And SameLD(3) = 1 Then
... there are always 3 function calls, while in a case below...
If SameLD(1) = 3 Then
If SameLD(2) = 2 Then
If SameLD(3) = 1 Then
... there might be from 3 to down to just 1 call, which saves time
(If first condition is not satisfied then rest of checks are not performed).
And of course, last approach is more preferable.

But what I ment was to call Sub SameLD() (sub, not a function.
It has no parameters at all, and it is called just once.
What it does, it calculates SameLDs for ALL six numbers A to F at a single shot
and populates a SameLDArray array (or you can call it nLD for consistancy),
which should be defined as
dim nLD(0 to 9) as integer

Before doing any comparing, call sub:

SameLD

...and then whenever you need nLD values you query the prepopulated *ARRAY* (which is a nLD array)
rather than call function. It's faster.
So "If SameLD(1) = 3 And SameLD(2) = 2 And SameLD(3) = 1 Then"
becomes a
"If nLD(1) = 3 And nLD(2) = 2 And nLD(3) = 1 Then"
and there are no function calls involved here. Again, if you change the above line to...
If nLD(1) = 3 Then
If nLD(2) = 2 Then
If nLD(3) = 1 Then
...it will be even better. However in this case difference in processing time (nested "ifs" vise combined "if") may be
not that substantial as a difference in case of using functions just because arrays are faster. But still, nested is better.

dim nSD(0 to 4) as integer
SameDecade'this is a sub call, performs once to populate nSD array
...later on when quering same decade values you use

if nSD(0)=... and/or nSD(1/2/whatever..)=... etc. then

or, using nested ifs:
if nSD(0)=3 then
if nSD(1)>2 then
if....

and here goes SameDecade sub:

sub SameDecade
dim i as integer
for i=0 to 4
nSD(i)=0
next
if A>=40 then
nSD(4)=nSD(4)+1
elseif A>=30 then
nSD(3)=nSD(3)+1
elseif A>=20 then
nSD(2)=nSD(2)+1
elseif A>=10 then
nSD(1)=nSD(1)+1
else
nSD(0)=nSD(0)+1
end if

repeat the same block for "B" throug "F"
if B>=40 then
nSD(4)=nSD(4)+1
....

if C>=
...
if F..
end sub

if for storing numbers(balls) you use array, e.g. Ball(1 to 6) instead of A,B,..F,
you can rewrite sub:

sub SameDecade
dim i as integer
for i=0 to 4
nSD(i)=0
next
for i=1 to 6
if Ball(i)>=40 then
nSD(4)=nSD(4)+1
elseif Ball(i)>=30 then
nSD(3)=nSD(3)+1
elseif Ball(i)>=20 then
nSD(2)=nSD(2)+1
elseif Ball(i)>=10 then
nSD(1)=nSD(1)+1
else
nSD(0)=nSD(0)+1
end if
end sub

But if you are used to A...F it's better to keep A..F in order not to get confused.

Did you have Any Luck on the Keno?, or shouldn't I ask.
Yesterday I was busy and forgot to buy tickets, and that was my luck

Good luck!
sss

 

[PAB]

Hi sss,
Thanks VERY Much,
What I am trying to do at the moment is stick to Function Calls ( because Most of the Program Relies on Functions ) until I get a bit More Experienced.
I can Certainly see the Benefit of using Arrays in Subs with Respect to making Tasks More Compact, as well as the Processing Time that is Saved. I will wait until I Understand them Better and I can get my head around Exactly how they work before I use them. They Certainly seem to be a Better Way to go.
I will Examine in More Detail the Two you have Explained in Previous Posts.
I Really wanted to use a Function Calls for SameDecade, and after your Post I have come up with the following, which I have Tested and they Appear to be OK :-

Function SameDecade0()
SameDecade0 = 0
If A <= 9 Then SameDecade0 = SameDecade0 + 1
If B <= 9 Then SameDecade0 = SameDecade0 + 1
If C <= 9 Then SameDecade0 = SameDecade0 + 1
If D <= 9 Then SameDecade0 = SameDecade0 + 1
If E <= 9 Then SameDecade0 = SameDecade0 + 1
If F <= 9 Then SameDecade0 = SameDecade0 + 1
End Function

Function SameDecade1()
SameDecade1 = 0
If A >= 10 And A <=19 Then SameDecade1 = SameDecade1 + 1
If B >= 10 And B <=19 Then SameDecade1 = SameDecade1 + 1
If C >= 10 And C <=19 Then SameDecade1 = SameDecade1 + 1
If D >= 10 And D <=19 Then SameDecade1 = SameDecade1 + 1
If E >= 10 And E <=19 Then SameDecade1 = SameDecade1 + 1
If F >= 10 And F <=19 Then SameDecade1 = SameDecade1 + 1
End Function

To

Function SameDecade4()
SameDecade4 = 0
If A >= 40 And A <=49 Then SameDecade4 = SameDecade4 + 1
If B >= 40 And B <=49 Then SameDecade4 = SameDecade4 + 1
If C >= 40 And C <=49 Then SameDecade4 = SameDecade4 + 1
If D >= 40 And D <=49 Then SameDecade4 = SameDecade4 + 1
If E >= 40 And E <=49 Then SameDecade4 = SameDecade4 + 1
If F >= 40 And F <=49 Then SameDecade4 = SameDecade4 + 1
End Function

So now I can use :-
If SameDecade0 = 3 Then
If SameDecade1 = 1 Then
If SameDecade2 = 2 Then

I Appreciate that there are going to be Tasks that Can Only be Achieved with the use of Arrays.
Thanks for all your time and effort.
ALL the Best
PAB

 

[sss]

Hi sss,
Tested and they Appear to be OK :-

Function SameDecade0()
SameDecade0 = 0
If A <= 9 Then SameDecade0 = SameDecade0 + 1
If B <= 9 Then SameDecade0 = SameDecade0 + 1
If C <= 9 Then SameDecade0 = SameDecade0 + 1
If D <= 9 Then SameDecade0 = SameDecade0 + 1
If E <= 9 Then SameDecade0 = SameDecade0 + 1
If F <= 9 Then SameDecade0 = SameDecade0 + 1
End Function
ALL the Best
PAB

Hi PAB,

just one little thing left - to finally get that ever elusive thing cought
Other than tat everything if fine. Good luck!
sss

 

[PAB]

Hi sss,
Thanks for All the help you have given .
I will use ALL the Information I have got to try and get the 14 Million Combinations down to some Sort of Manageable Size. Thank you for ALL the Detailed Explanations and Insight that Accompanied the Code.
I have Listed ALL the things that I think are the Most Important to the Program. One thing that would help me no end have a Better Understanding of what is going on and why would be a Brief Explanation of the Following Pleeaassee.

Criteria & Explanation

Group Criteria = Input Sheet for the Numbers to be used in the Custom Grid.
Combinations = Where the Combinations Produced from the Program are Written to.
Dim N
Dim nMinA = The Minimum Value to be used for A.
Dim nMaxF = The Maximum Value to be used for F.
Dim CriteriaColumns = The Criteria to be used in the Collection for the Custom Grid.
Dim ColumnNumbers() = The Columns Numbers to be used in the Collection for the Custom Grid.
Dim TotalColumns = The Total Columns used in the Collection for the Custom Grid.
Dim ColumnCount() = Count Each Column to be used in the Custom Grid.
Dim ThisCriteria
TestCriteria
getCriteria = Instruction to get the Criteria that is being used in the Custom Grid.
Dim Done
Dim i&
Dim j&
Dim Column&
Dim Arr(1 To 6) = Dim Array for Balls 1 to 6 ( A - F ).
Dim Ball
Dim Maximum
Dim strResult
Dim z
Column
strResult
CInt(strResult)
Dim col&
Dim row&
Digit
CInt(strResult)
New Collection

Thanks for Everything .
I hope you DO NOT have to wait Too Long to Win what you are Destined for, the JP .
May the Force ( Lotto Force that is ) be With You.
Cheers and All the Best
PAB

 

[sss]

Hi PAB,

I think it would be better if you send me your entire VBA module,
and I'll comment it and where it is needed I'll explain it more detailed. It may take certain time cause you don't need line-by-line comments only, you want to get a conceptual vision of how
is it built. Am I right?
I'm leaving for vacations on Jul 14, so before that I'll reply you
for sure.
<<< email addy deleted >>>

sss

BTW: I like your smilies with beer
Thanks!

 

[PAB]

Hi sss,

Have you had Chance to Comment the Macro I sent you yet?.
If you are too Busy getting ready for your Hols, by all Means leave it until after you get back.
Have a Good Holiday .

All the Best
PAB

 

[sss]

Hi sss,

Have you had Chance to Comment the Macro I sent you yet?.
If you are too Busy getting ready for your Hols, by all Means leave it until after you get back.
Have a Good Holiday .

All the Best
PAB

Hi PAB,

Don't worry, I'll send it to you befor I leave, the thing is
I'm really too busy now
By the way, following your advice I tried to edit my last post to
remove email, but it turned to be impossible - they don't allow
to edit after 24 hours since it's been posted

sss

 

[PAB]

Hi sss,

Thanks for that, I look forward to receiving it.
You could drop LT ( the Administrator ) an email asking him to remove it for you.

Cheers
PAB

 

[sss]

Hi sss,

Thanks for that, I look forward to receiving it.
You could drop LT ( the Administrator ) an email asking him to remove it for you.

Cheers
PAB

Hi, PAB,

did you get my email that I've sent you couple of days ago?
I hope yes. Anyway, I'm leaving now
Also, I uploaded program that I've mentioned. Although you're
not a Keno guy, I would still like to ask you to go through it and
make some notes for me. I need somebody who speaks perfect
English to correct and refine my English interface text.
I'll really appreciate a help.
It' s here:
<<< link to program with possible virus deleted >>>
Good luck in struggling with VBA and hunting that "ever elusive jackpot"!
sss

 

[Karnac]

Hi, PAB,

did you get my email that I've sent you couple of days ago?
I hope yes. Anyway, I'm leaving now
Also, I uploaded program that I've mentioned. Although you're
not a Keno guy, I would still like to ask you to go through it and
make some notes for me. I need somebody who speaks perfect
English to correct and refine my English interface text.
I'll really appreciate a help.
It' s here:
<<< link to program with possible virus deleted >>>
Good luck in struggling with VBA and hunting that "ever elusive jackpot"!
sss

Warning
sss , I took the liberty to download your fine program, but be advised it set off my Norton antivirus as having malicious script. Hope you can post a clean copy,it looks really good.
I have advised LT.

 

[LT]

Thanks Karnac for the warning.

sss - please check the program and then re post the link when it is OK .

 

[sss]

Thanks Karnac for the warning.

sss - please check the program and then re post the link when it is OK .

It IS ok. I have no idea what could it be the Norton antivirus found to be a suspicious script inside it.
DO NOT download it if you have any concerns!
But in fact it is absolutely clean.
Good luck!
sss