to maggie -

G

GillesD

Member
Combinations for specific sums

Yes, Nick, the changes made provide the right data for all sums from 21 to 279 (for a 6/49 lottery). Going through all sums now gives 13,983,816 combinations where the initial code gave 14,886,520 combinations.

For somebody interested only in a 6/49 lottery, the small code listed below will list in an Excel sheet the Sum Value in column A (from 21 to 279) and in column B, the number of combinations possible for each sum.

Option Explicit
Option Base 1

Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer
Dim I As Integer, nSum(279) As Long

Sub Set_AllSums()
Range("A1").Value = "Sum Value"
Range("B1").Value = "# comb."
Application.ScreenUpdating = False
Range("A2").Select
For I = 21 To 279
nSum(I) = 0
Next I
For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49
nSum(A + B + C + D + E + F) = nSum(A + B + C + D + E + F) + 1
Next F
Next E
Next D
Next C
Next B
Next A
For I = 21 To 279
ActiveCell.Value = I
ActiveCell.Offset(0, 1).Value = nSum(I)
ActiveCell.Offset(1, 0).Select
Next I
Range("A1").Select
Application.ScreenUpdating = True
End Sub


And by the way, if you want to see an almost perfect normal distribution (bell-shaped), make a graph of the data listed in column B (on the Y-axis) against the data in column A (on the X-axis). An example I use to demonstrate the concept of normal distribution.
 
P

PAB

Member
Hi GillesD,

Is there a way to adapt your Macro :-

Sub Comb_Sum()
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer
Dim N As Long, nSum As Integer, nSumMin As Integer, nSumMax As Integer
' Set nSumMin and nSumMax to the values (minimum and maximum) you want the sum to cover
' if you want to meet a single value, set both nSumMin and nSumMax to that value
nSumMin = 145
nSumMax = 155
Range("A1").Select
Application.ScreenUpdating = False
N = 0
For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49
nSum = A + B + C + D + E + F
If N = 65000 Then
N = 1
ActiveCell.Offset(-65000, 1).Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End If
If nSum >= nSumMin And nSum <= nSumMax Then
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")
ActiveCell.Offset(1, 0).Select
End If
Next F
Next E
Next D
Next C
Next B
Next A
Application.ScreenUpdating = True
End Sub

to exclude Combinations that contain ALL Odds and Evens, ALL Prime Numbers, Consecutive Numbers ( but maybe leaving in Two Consecutives ), Setting the Minimum of the First Number ( i.e. Ball Number 8 ) and the Maximum of the Last Number ( i.e. Ball Number 46 ) and maybe even Setting the Range of the Numbers ( i.e. 3,7,10,25,35,46 = a Range of 43 ).:dizzy:

All the Best
PAB
 
G

GillesD

Member
Listing of combinations

PAB,

I have modified the macro to be as flexible as possible. Examples are given for the criteria you mentioned (sum meeting certain values, not all even, odd or prime numbers, no three consecutive numbers, specific range, minimum and maximum values). But you can remove any criteria you do not want or even better, develop your own.

The macro List_Comb will list all combinations in the form N1-N2-N3-N4-N5-N6 in adjacent columns starting at A. You can modify the minimum value for the first number and the maximum value for the last number by changing respectively the values for MinA and MaxF (set in the macro for 1 and 49) near the top of the macro.

Before listing a combination in cell, the macro use a function to verify if the values A to F meet a criteria. Any number of criteria can be set and all of them must be met if the combination is to be listed. In this case, the functions are respectively SumAF (here set between 135 and 155), RangeAF (here set at lower or equal to 40), Not3Cons, NotAllEven, NotAllOdd and NotAllPrime.

When removing or adding any call to a function by the statement “If Function then” in the section identified for this, make sure there are as many “End If” statements in the section following the statement “Activecell.Value ….”. The order for the criteria may affect the speed of the macro and it will probably run faster if criteria that eliminate the most combinations are placed at the top.

I hope the explanations are clear enough but ask if not satisfactory. I have not fully tested the macro with all criteria; let me know if there is a bug.

Here are the macro and the various functions:

Option Explicit
Public A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer

Sub List_Comb()
Dim N As Long, nMinA As Integer, nMaxF As Integer
Range("A1").Select
Application.ScreenUpdating = False
N = 1
Selection.ColumnWidth = 18
ActiveCell.Value = "Comb."
' Change minimum value for A or maximum value for F if appropriate
nMinA = 1
nMaxF = 49
For A = nMinA To nMaxF - 5
For B = A + 2 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
ActiveCell.Value = "Comb."
End If
' Insert here as many IF ... statements as necessary to list combinations meeting your criteria
If SumAF Then
If RangeAF Then
If Not3Cons Then
If NotAllPrime Then
If NotAllEven Then
If NotAllOdd 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")
' Insert here as many END IF statements as you added IF ... Then statements
End If
End If
End If
End If
End If
End If
Next F
Next E
Next D
Next C
Next B
Next A
Application.ScreenUpdating = True
End Sub

Function SumAF()
' Return True if the condition for the sum (A - F) is satisfied
SumAF = False
If A + B + C + D + E + F >= 135 And A + B + C + D + E + F <= 155 Then SumAF = True
End Function

Function RangeAF()
' Return TRUE if the condition for the range A - F is satisfied
RangeAF = False
If F - A <= 40 Then RangeAF = True
End Function

Function Not3Cons()
' Return True if there is no 3 consecutive numbers (A to F)
Not3Cons = False
If C - A > 2 And D - B > 2 And E - C > 2 And F - D > 2 Then Not3Cons = True
End Function

Function NotAllEven()
' Return True if at least one number (A to F) is odd
NotAllEven = False
Select Case A
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case B
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case C
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case D
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case E
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case F
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
End Function

Function NotAllOdd()
' Return True if at least one number (A to F) is even
NotAllOdd = False
Select Case A
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllEven = True
Exit Function
End Select
Select Case B
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case C
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case D
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case E
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case F
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
End Function

Function NotAllPrime()
' Return True if at least one number (A to F) is not prime
NotAllPrime = True
Select Case A
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case B
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case C
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case D
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case E
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case F
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
NotAllPrime = False
Exit Function
End Select
End Select
End Select
End Select
End Select
End Select
End Function
 
P

PAB

Member
Hi GillesD,

Thank you VERY, VERY much.:beer:
My Prime Objective is to hit the "BIG ONE" as opposed to Winning Smaller Prizes.
I have looked through your Macro ( in my limited experience of Macro's ) and can see the Logic and Potential in its Structure.
There is a Limit to the Number of Filters you can apply to reduce the Combinations, but still hopefully leave the Combination that contains that ever elusive JACKPOT.
How would you Incorporate the "MOD" Function if you wanted to Exclude Certain Last Digit Criteria? ( i.e. ALL Last Digits the Same ).
Also, would it be better to set up individual Functions for the Total Difference from One Number ( Ball 1-2, 2-3, 3-4, 4-5 & 5-6 ) to the Next, or Set it up as One Function i.e.
Function BallDiff()
BallDiff = False
If B - A <= 5 And C - B <= 5 And D - C <= 5 And E - D <= 5 And F - E <= 5 Then BallDiff = True
End Function


Thank you so much for your time and effort.:)

All the Very Best
PAB
:wavey:
 
Last edited:
G

GillesD

Member
Best function

PAB, regarding your question about the best way to get only combinations where difference between consecutive numbers is always <= 5, I tested various options. Incidently, there are 106,250 such combinations.

A - Using a function
Calling a function for testing some condition is not the fastest method; it is always faster to place the condition directly in the macro itself. In my macro, I choose the Function method as this allows having multiple functions available and then calling them as necessary which facilitate setting up the macro to test for different conditions.

B - Single IF statement compared to nested IF statements:
The function BallDiff you developped is quite functionnal but not the fastest method. With nested IF statements (checking for B-A, then continuing if True to C-B and so on ...) is faster as you check far less combinations overall. Once B-A is > than 5, other IF statements are not executed, thus accelerating the process.
 
P

PAB

Member
Hi GillesD,

Thanks for looking at my Function BallDiff() and the Explanation.
I ran your Macro without any of the Functions with the setting of
nMinA = 1
nMaxF = 10
and noticed that :-
For B = A + 2 To nMaxF - 4 should be For B = A + 1 To nMaxF - 4
After changing that it was fine.
I tried to run the Function SumAF() but without any success, I am sure that it is something I did, I will have another look at it tomorrow.
How would you Incorporate the "MOD" Function if you wanted to Exclude Certain Last Digit Criteria? ( i.e. ALL Last Digits the Same ).

Once again Thank You for your help.
Good Luck Tonight
All the Beat
PAB
:wavey:
 
P

PAB

Member
Hi GillesD,

I tried running it with the Function SumAF() included again and it said it was expecting an End Sub or End If Statement, I made a few changes and then it came up with a Block Error. Have you got any ideas ( I know it is probably my limited knowledge causing the problem ). Thanks very much.

All the Best
PAB
:wavey:
 
G

GillesD

Member
To PAB

A - Error in my macro:
You are absolutely right, the line FOR B = A+2 to nMaxF - 4 should read FOR B = A+1 to nMaxF - 4. Sorry about the inconvenience.

B - Look for an END IF or END SUB statement
One thing to look for in this case is how the condition is written.
If you put your statement on one line (in the form "IF condition THEN statement"), you do not need an ENDIF statement.
But if you set it up with "IF condition THEN" on one line, then on one or more lines, you enter your statement(s) that you want to run if the condition is true, then you need to add an END iF statement where the conditionnal block ends.

C - The MOD operator
To identify the last digit of an integer value, you can use the MOD operator. For example, if A=34, the statement X = A MOD 10 will assign the value 4 to X.
To check if A and B have the same last digit, the following statement will return TRUE in the variable TEST if it is the case and FALSE if not
IF A MOD 10 = B MOD 10 THEN TEST=TRUE ELSE FALSE
 
P

PAB

Member
Hi GillesD,

Thanks for the reply.
I am sure that someone with more Macro knowledge than me fully understands the explanations you have given. I can see the Logic and Potential for achieving most results based on Specific Criteria.
I have tried to incorporate the Function SumAF() into the Macro but to no avail. My main problem is not knowing ( Although you have given the areas ) exactly which bits go where. I wondered if I need to define them first.
Once again, thank you very much for your kind help :agree:

All the Best
PAB
:wavey:
 
G

GillesD

Member
Problem with the macro

PAB

IF … THEN … ELSE … END IF
The proper structure for these statements is (note that the 2 lines starting with ELSE are optional):
IF condition to be evaluated THEN
statement(s) to be executed if the condition returns TRUE
ELSE
statement(s) to be executed if the condition returns FALSE
END IF

But it is can be simplified to a single line if there is a single statement to be executed if the condition returns TRUE. This can be simplified to:
IF condition THEN statement

There may be two things to verify to ensure proper running of the macro:
A – Nested IF statements
In my macro, I use nested IF statements (IF SumAF THEN, IF RangeAF THEN and 4 more), you must make sure that there are as many END IF statements at the end of the conditional block of code (before the NEXT F statement), otherwise an error will result.

B – Copying error
When a line is too long, VBA allows to use the _ character to indicate that the line continues on the next line. I use that extensively in the ACTIVECELL.VALUE= statement which takes 6 lines. I just noticed that a line that should be written on a single line may appear on 2 lines on the screen depending on the screen width, zoom, etc. And if you copy from the screen in a module, the text (but not always) may be copied on 2 lines, which will cause an error. Just a little thing to check.

Otherwise, if this does not work, I do not have any other explanations. The only possible solution would be to send you my Excel file through LT and you could compare it to your own file.
 
P

PAB

Member
Hi GillesD,

Once again, thank you very much for your time and effort.
I ran the Macro this morning in its entirety with only one glitch :-

Function NotAllOdd()
Return True if at least one number (A to F) is even
NotAllOdd = False
Select Case A
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48

NotAllEven = True <--------------- Should be NotAllOdd = True

Exit Function
End Select

I changed this and it worked.
I will play around with adding some more Criteria in the hope of reducing the total number of Combinations to a more managable size. The main Two I will try and achieve is regarding Last Digits and Decades.
Thank you for all the detailed explanations, I have read them several times and they are now becoming more clearer.

All the Very Best
PAB
:wavey:
 
P

PAB

Member
Idea I Have Had

Hi GillesD,

I have had an idea about Developing a Custom Grid for some time now. I will try and explain what I mean. Each Lotto ( as far as I know, and I am sure someone will correct me if I am wrong ) is played by entering a "DASH" or whatever on the Play Board for the Numbers you want to play. The Structure of the Play Board is Set by the Lotto Company ( which can be changed at any time ). I think that this Set Structure greatly reduces ( because people try to avoid Patterns ) the Number of Combinations played ( and as you know, the Lotto Company is very clandestine about the information they are willing to share with us, the paying public that keep the fat cats fat ). If we were to create our own Play Board Structure, and fill in Numbers Randomly for example, I think Combinations that would NOT normally be Played would appear, therefore reducing the Number of Rollovers.
If you take the example grid below, and wanted to Exclude ( in Addition to, or instead of, the other criteria that has already been Set ) Combinations that had less than say Five Numbers from ANY One column, with the other Two Numbers in ANY One other column, or have Three Numbers from One column, Two Numbers from another column and the Last Number from One other column, be too complex a task to include into your excellent Macro. It would be nice to be able to change the Criteria for whatever scenario you desire. Can you use the { } in a Macro, I say this because it would make it easier ( in my limited knowledge ) to change the Structure of the grid to whatever you desire.
I know myself, at this present time, this is far beyond my capabilities ( with regard to writing the code to include this into the Macro ). Do you think there is any mileage in this idea, or do you have any other ideas regarding this concept. It basically needs to be flexible enough to be able to be changed regardless of the grid structure.

Example Grid :-
01,02,03,04,05
06,07,08,09,10
11,12,13,14,15
16,17,18,19,20
21,22,23,24,25
26,27,28,29,30
31,32,33,34,35
36,37,38,39,40
41,42,43,44,45
46,47,48,49

Thinking about it, I should Set up a New Thread for this. If I get some time at the weekend, I will try and explain this better and in more detail, because at the end of the day, we are ALL here to exchange ideas and try to win that "Ever Elusive Jackpot".

All the Very Best
PAB
:wavey:
 
G

GillesD

Member
Revised macro

Here is the corrected macro to list the combinations that meet certain conditions. These conditions are verified through function calls. Conditions can be added, removed and new ones developed if necessary. I have tried to add comments to indicate what is intended by each section of the code


Option Explicit
Public A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer

Sub List_Comb()
' Macro to list combinations in an Excel sheet
' if they meet various criteria
Dim N As Long, nMinA As Integer, nMaxF As Integer
Range("A1").Select
Application.ScreenUpdating = False
N = 1
Selection.ColumnWidth = 18
ActiveCell.Value = "Comb."
' Change minimum value for A or maximum value for F
' to cover range of values to be covered
nMinA = 1
nMaxF = 49
' Start of loops for 6 variables
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
' Verification of number of combinations posted
' and move to top of ext column if 65,000
If N = 65001 Then
Selection.ColumnWidth = 18
N = 1
ActiveCell.Offset(-65000, 1).Select
Application.ScreenUpdating = True
Application.ScreenUpdating = False
ActiveCell.Value = "Comb."
End If
' Insert here as many IF ... statements as necessary
' to select combinations meeting the criteria you want
‘ The function must return TRUE to continue and eventually list
If SumAF Then
If RangeAF Then
If Not3Cons Then
If NotAllPrime Then
If NotAllEven Then
If NotAllOdd Then
' Copying the combination in the form N1-N2-N3-N4-N5-N6
' in an Excel cell if the combination meets all criteria
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")
' Insert here as many END IF statements
' as you added IF ... THEN statements above
End If
End If
End If
End If
End If
End If
Next F
Next E
Next D
Next C
Next B
Next A
Application.ScreenUpdating = True
End Sub

Function SumAF()
' Return True if the condition for the sum of A to F is satisfied
' Change values as necessary (minimum = 21 and maximum = 279)
SumAF = False
If A + B + C + D + E + F >= 21 And A + B + C + D + E + F <= 279 Then SumAF = True
End Function

Function RangeAF()
' Return TRUE if the condition for the range A - F is satisfied
' Chnage values as necessary (minimum = 5 and maximum = 48 for a 6/49 lottery)
RangeAF = False
If F - A <= 48 Then RangeAF = True
End Function

Function Not3Cons()
' Return True if there are no 3 consecutive numbers in A to F
Not3Cons = False
If C - A > 2 And D - B > 2 And E - C > 2 And F - D > 2 Then Not3Cons = True
End Function

Function NotAllEven()
' Return True if at least one number (A - F) is odd
NotAllEven = False
Select Case A
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case B
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case C
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case D
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case E
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
Select Case F
Case 1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49
NotAllEven = True
Exit Function
End Select
End Function

Function NotAllOdd()
' Return True if at least one number (A - F) is even
NotAllOdd = False
Select Case A
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case B
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case C
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case D
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case E
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
Select Case F
Case 2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48
NotAllOdd = True
Exit Function
End Select
End Function

Function NotAllPrime()
' Return True if at least one number in A to F is not prime
' Remember that 1 is not considered a prime number
NotAllPrime = True
Select Case A
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case B
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case C
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case D
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case E
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
Select Case F
Case 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47
NotAllPrime = False
Exit Function
End Select
End Select
End Select
End Select
End Select
End Select
End Function


Please note that when numbers are listed in the CASE statement for even, odd and prime numbers, they should be all on the same line.
 
P

PAB

Member
Last Digit

Hi GillesD,

I know you said that you can use the MOD Function to find the Last Digit. Would this work below ( example to test if the Last Digit is 1 for 5 of the 6 Numbers ), that way if you wanted to exclude 3 or 4 Last Digits the same it just means changing the 5.

If SameLastDigit1 = 5 Then

Function SameLastDigit1()
SameLastDigit1 = True
Select Case A
Case 1,11,21,31,41
Select Case B
Case 1,11,21,31,41
Select Case C
Case 1,11,21,31,41
Select Case D
Case 1,11,21,31,41
Select Case E
Case 1,11,21,31,41
Select Case F
Case 1,11,21,31,41
SameLastDigit1 = False
Exit Function
End Select
End Select
End Select
End Select
End Select
End Select
End Function

End If

Thanks GillesD
All the Best
PAB
 
G

GillesD

Member
Function for last digit

PAB

Your function SameLastDigit1 will not work as you assign it the value TRUE or FALSE but then verify if it equals 5.

The function SameLD given below should work as intended and is a little more flexible (you can set the last digit to whatever value you want and the number of times you want it. To use it, do the following:

A – Add the line “Dim nLD As Integer” at the top to declare nLD as an integer

B – Before you start looping through variables A to F, add the line “nLD = XXX” where XXX will be the last digit you want to check for (in your case 1)

C – To check for a certain number of occurrences of the last digit, add the line “If SameLD = YYY Then”, where YYY will be the number of times you want the last number (in your case 5). If you do not want a specific number of times the last digit appear, then the line should read ““If Not SameLD = YYY Then”

D – Add the function listed below at the end:

Function SameLD()
SameLD = 0
If A Mod 10 = nLD Then SameLD = SameLD + 1
If B Mod 10 = nLD Then SameLD = SameLD + 1
If C Mod 10 = nLD Then SameLD = SameLD + 1
If D Mod 10 = nLD Then SameLD = SameLD + 1
If E Mod 10 = nLD Then SameLD = SameLD + 1
If F Mod 10 = nLD Then SameLD = SameLD + 1
End Function
 
P

PAB

Member
Decades

Hi GillesD,

Thanks for your time and the information on Last Digits, it worked a treat :agree:.
For Decades would it be better to use Nested IF Statements or use something like this ( and then Repeated for the Other Decades ) :-

Function to Check if A - F are the Same Decade

Function NotAllDecade0()
Return True if At Least One Number in A to F is NOT Decade 0
NotAllDecade0 = True
Select Case A
Case 1,2,3,4,5,6,7,8,9
Select Case B
Case 1,2,3,4,5,6,7,8,9
Select Case C
Case 1,2,3,4,5,6,7,8,9
Select Case D
Case 1,2,3,4,5,6,7,8,9
Select Case E
Case 1,2,3,4,5,6,7,8,9
Select Case F
Case 1,2,3,4,5,6,7,8,9
NotAllDecade0 = False
Exit Function
End Select
End Select
End Select
End Select
End Select
End Select
End Function

Or would the best way be to Set it up in the same Format as Last Digits, that way you could take out ALL the Combinations that are the same Decade or have NO Combination with more than say Three Numbers in any One Decade for example. The only thing is though, how would you incorporate Decade 1 ( Numbers 10 to 19 ):confused:.

Thanks Very Much.
All the Best
PAB
:wavey:
 
P

PAB

Member
Hi GillesD,

Basically I want to IGNORE Combinations that do NOT include ALL the Numbers in the Criteria below ( I am working on the Custom Grid Structure ). I have tried a couple of ways but without any success.

The First one I tried was :-

Function to Check if A - F ( are Included ONLY in Columns 1 & 2 ) Meets the Specific Criteria

Function NotAllGridColumns12()

NotAllGridColumns12 = True
Select Case A
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
Select Case B
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
Select Case C
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
Select Case D
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
Select Case E
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
Select Case F
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
NotAllGridColumns12 = False
Exit Function
End Select
End Select
End Select
End Select
End Select
End Select
End Function

The Second one I tried was :-

Function NotAllGridColumns12()

NotAllGridColumns12 = False
Select Case A
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
NotAllGridColumns12 = True
Exit Function
End Select
Select Case B
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
NotAllGridColumns12 = True
Exit Function
End Select
Select Case C
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
NotAllGridColumns12 = True
Exit Function
End Select
Select Case D
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
NotAllGridColumns12 = True
Exit Function
End Select
Select Case E
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
NotAllGridColumns12 = True
Exit Function
End Select
Select Case F
Case 1,6,11,16,21,26,31,36,41,46,2,7,12,17,22,27,32,37,42,47
NotAllGridColumns12 = True
Exit Function
End Select
End Function

For some reason neither of them worked. Would you please have a quick look at them and point me in the right direction.
Thank You Very Much.

Good Luck Tonight
All the Best
PAB
:wavey:
 
You must log in or register to reply here.

Sidebar

Top