Magic esquire 3x3

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,362
Office Version
  1. 2010
Hello,

Is it possible to create all possible magic esquire 3x3 which total must be 14 using 0 to 8 numbers? Numbers can be used repeated

Like example shown below...


Book1
ABCDEF
1
2
30312
41021
52032
63
74521
85203
96010
107
118321
12114
13101
14
15320
16122
17013
18
19310
20151
21120
22
23521
24003
25012
26
27221
28322
29110
30
31322
32211
33012
34
35421
36001
37231
38
39160
40222
41100
42
43013
44113
45122
46
47122
48111
49123
50
51212
52112
53131
54
55621
56301
57001
58
59
Sheet2


Thank you all
Excel 2000
Regards,
Moti
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Hello, Please ignore posrt#1

I think not to complicate making esquires could be made all possible set using 0 to 8 numbers, could be repeated, which line total must be 14

New example


Book1
ABCDEFGHIJKLMN
1
2Sum
3031202103214
4152120301014
5232111410114
6332012201314
7431015112014
8552100301214
9622132211014
10732221101214
11842100123114
1216022210014
1301311312214
1412211112314
1521211213114
1662130100114
17
18
19
20
21
22
23
24
25
26
27
28
Sheet3


Thank you
Regards
Moti
 
Upvote 0
have 9 loops all going from 0 to 8 and after each loop check total
if equal to 14 make remaining numbers zero
if greater than 14 ignore and update PREVIOUS loop

ie
for A= 0 to 8
for B=0 to 8 etc etc
 
Upvote 0
oldbrewer said:
have 9 loops all going from 0 to 8 and after each loop check total
if equal to 14 make remaining numbers zero
if greater than 14 ignore and update PREVIOUS loop

ie
for A= 0 to 8
for B=0 to 8 etc etc
Click to expand...
Hello oldbrewer,
May be like shown below 1st set 0,0,0,0,0,0,0,6,8 & last one 8,6,0,0,0,0,0,0,0

Example.


Book1
ABCDEFGHIJKLMN
1
2Sum
3000000006814
4100000060814
5200000600814
6300006000814
7400060000814
8500600000814
9606000000814
10760000000814
11800000007714
1200000070714
1300000700714
1400007000714
1500070000714
1686000000014
17
18
19
20
21
22
23
24
25
26
27
28
Sheet4


Thank you
Regards
Mot
 
Upvote 0
oldbrewer said:
yes - there will be a lot of answers......do you need them all or say just 100 ?
Click to expand...
Hello oldbrewer,
Do you know how much could be all? i have no idea how to calculate them

Is it possible to at have all, if not could be 100 random as you can

Thank you
Regards
Moti
 
Upvote 0
Code: 
Sub moti()
  Const m           As Long = 9
  Dim i             As Long
  Dim n             As Long
  Dim aiInx(1 To 9) As Long
  Dim aiMin(1 To 9) As Long
  Dim aiMax(1 To 9) As Long
  Dim aiOut(1 To 308187, 1 To 9) As Long
  Dim iSum          As Long

  For i = 1 To m
    aiMax(i) = 8
  Next i

  NestedFor aiInx, aiMin, aiMax, True

  Do While NestedFor(aiInx, aiMin, aiMax)
    iSum = 0
    For i = 1 To m
      iSum = iSum + aiInx(i)
      If iSum > 14 Then Exit For
    Next i

    If iSum = 14 Then
      n = n + 1

      For i = 1 To 9
        aiOut(n, i) = aiInx(i)
      Next i

      If (n And &H3FF&) = 0& Then
        Application.StatusBar = Format(n, "#,##0")
        DoEvents
      End If
    End If
  Loop

  Range("A1").Resize(UBound(aiOut, 1), UBound(aiOut, 2)).Value = aiOut
  Application.StatusBar = False
End Sub

Function NestedFor(aiInx() As Long, aiMin() As Long, aiMax() As Long, _
                   Optional bInit As Boolean = False) As Boolean
  ' shg 2007

  ' Changes array aiInx to the next iteration, varying aiInx between the values
  ' in aiMin and aiMax. The three arrays must all be 1-based and the same size.

  ' aiInx(m) is the innermost loop

  ' To initialize aiInx so that the *next* call returns the first iteration,
  ' call with bInit True.

  ' Init returns           {aiMin(1), aiMin(2), ..., aiMin(m) - 1}
  ' The first iteration is {aiMin(1), aiMin(2), ..., aiMin(m)}
  ' The last is            {aiMax(1), aiMax(2), ..., aiMax(m)}

  ' Returns False when no more iterations exist

  Dim i             As Long
  Dim m             As Long

  m = UBound(aiInx)

  If bInit Then
    For i = 1 To m - 1
      aiInx(i) = aiMin(i)
    Next i
    aiInx(m) = aiMin(i) - 1
    NestedFor = True

  Else
    For i = m To 1 Step -1
      If aiInx(i) < aiMax(i) Then
        aiInx(i) = aiInx(i) + 1
        Exit For
      End If
      aiInx(i) = aiMin(i)
    Next i
    NestedFor = i > 0
  End If
End Function

Pretty boring parade:

A​
B​
C​
D​
E​
F​
G​
H​
I​
1​
0​
0​
0​
0​
0​
0​
0​
6​
8​
2​
0​
0​
0​
0​
0​
0​
0​
7​
7​
3​
0​
0​
0​
0​
0​
0​
0​
8​
6​
4​
0​
0​
0​
0​
0​
0​
1​
5​
8​
5​
0​
0​
0​
0​
0​
0​
1​
6​
7​
6​
0​
0​
0​
0​
0​
0​
1​
7​
6​
7​
0​
0​
0​
0​
0​
0​
1​
8​
5​
8​
0​
0​
0​
0​
0​
0​
2​
4​
8​
9​
0​
0​
0​
0​
0​
0​
2​
5​
7​
10​
0​
0​
0​
0​
0​
0​
2​
6​
6​
11​
0​
0​
0​
0​
0​
0​
2​
7​
5​
308179​
8​
4​
2​
0​
0​
0​
0​
0​
0​
308180​
8​
5​
0​
0​
0​
0​
0​
0​
1​
308181​
8​
5​
0​
0​
0​
0​
0​
1​
0​
308182​
8​
5​
0​
0​
0​
0​
1​
0​
0​
308183​
8​
5​
0​
0​
0​
1​
0​
0​
0​
308184​
8​
5​
0​
0​
1​
0​
0​
0​
0​
308185​
8​
5​
0​
1​
0​
0​
0​
0​
0​
308186​
8​
5​
1​
0​
0​
0​
0​
0​
0​
308187​
8​
6​
0​
0​
0​
0​
0​
0​
0​
 
Upvote 0
shg said:
Code: 
Sub moti()
  Const m           As Long = 9
  Dim i             As Long
  Dim n             As Long
  Dim aiInx(1 To 9) As Long
  Dim aiMin(1 To 9) As Long
  Dim aiMax(1 To 9) As Long
  Dim aiOut(1 To 308187, 1 To 9) As Long
  Dim iSum          As Long

  For i = 1 To m
    aiMax(i) = 8
  Next i

  NestedFor aiInx, aiMin, aiMax, True

  Do While NestedFor(aiInx, aiMin, aiMax)
    iSum = 0
    For i = 1 To m
      iSum = iSum + aiInx(i)
      If iSum > 14 Then Exit For
    Next i

    If iSum = 14 Then
      n = n + 1

      For i = 1 To 9
        aiOut(n, i) = aiInx(i)
      Next i

      If (n And &H3FF&) = 0& Then
        Application.StatusBar = Format(n, "#,##0")
        DoEvents
      End If
    End If
  Loop

  Range("A1").Resize(UBound(aiOut, 1), UBound(aiOut, 2)).Value = aiOut
  Application.StatusBar = False
End Sub

Function NestedFor(aiInx() As Long, aiMin() As Long, aiMax() As Long, _
                   Optional bInit As Boolean = False) As Boolean
  ' shg 2007

  ' Changes array aiInx to the next iteration, varying aiInx between the values
  ' in aiMin and aiMax. The three arrays must all be 1-based and the same size.

  ' aiInx(m) is the innermost loop

  ' To initialize aiInx so that the *next* call returns the first iteration,
  ' call with bInit True.

  ' Init returns           {aiMin(1), aiMin(2), ..., aiMin(m) - 1}
  ' The first iteration is {aiMin(1), aiMin(2), ..., aiMin(m)}
  ' The last is            {aiMax(1), aiMax(2), ..., aiMax(m)}

  ' Returns False when no more iterations exist

  Dim i             As Long
  Dim m             As Long

  m = UBound(aiInx)

  If bInit Then
    For i = 1 To m - 1
      aiInx(i) = aiMin(i)
    Next i
    aiInx(m) = aiMin(i) - 1
    NestedFor = True

  Else
    For i = m To 1 Step -1
      If aiInx(i) < aiMax(i) Then
        aiInx(i) = aiInx(i) + 1
        Exit For
      End If
      aiInx(i) = aiMin(i)
    Next i
    NestedFor = i > 0
  End If
End Function

Pretty boring parade:


A​

B​

C​

D​

E​

F​

G​

H​

I​

1​

0​

0​

0​

0​

0​

0​

0​

6​

8​

2​

0​

0​

0​

0​

0​

0​

0​

7​

7​

3​

0​

0​

0​

0​

0​

0​

0​

8​

6​

4​

0​

0​

0​

0​

0​

0​

1​

5​

8​

5​

0​

0​

0​

0​

0​

0​

1​

6​

7​

6​

0​

0​

0​

0​

0​

0​

1​

7​

6​

7​

0​

0​

0​

0​

0​

0​

1​

8​

5​

8​

0​

0​

0​

0​

0​

0​

2​

4​

8​

9​

0​

0​

0​

0​

0​

0​

2​

5​

7​

10​

0​

0​

0​

0​

0​

0​

2​

6​

6​

11​

0​

0​

0​

0​

0​

0​

2​

7​

5​

308179​

8​

4​

2​

0​

0​

0​

0​

0​

0​

308180​

8​

5​

0​

0​

0​

0​

0​

0​

1​

308181​

8​

5​

0​

0​

0​

0​

0​

1​

0​

308182​

8​

5​

0​

0​

0​

0​

1​

0​

0​

308183​

8​

5​

0​

0​

0​

1​

0​

0​

0​

308184​

8​

5​

0​

0​

1​

0​

0​

0​

0​

308185​

8​

5​

0​

1​

0​

0​

0​

0​

0​

308186​

8​

5​

1​

0​

0​

0​

0​

0​

0​

308187​

8​

6​

0​

0​

0​

0​

0​

0​

0​

<tbody>
</tbody>
Click to expand...
shg, thank you so much, code seems to work but it stop at the line below, because I have max 65000 lines, may it need alteration to continue in the next columns, Please does it is possible?

Code: 
 Range("A1").Resize(UBound(aiOut, 1), UBound(aiOut, 2)).Value = aiOut

Thank you
Regards
Moti
 
Upvote 0
motilulla said:
shg, thank you so much, code seems to work but it stop at the line below, because I have max 65000 lines, may it need alteration to continue in the next columns, Please does it is possible?

Code: 
 Range("A1").Resize(UBound(aiOut, 1), UBound(aiOut, 2)).Value = aiOut

Thank you
Regards
Moti
Click to expand...
Hello,

Code stop at the line above and do not show any results, it is due to my version 2000 has line limits 65336, and total set are 308187, please require modification after 65000 rows continue generating in the next sheet or next columns in the same sheet.

Thank you

Regards
Moti
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Counting how much number is in ascending order in a row.
2
Replies
12
Views
388
Peter_SSs
Peter_SSs
E
  • Solved
Formula to Auto Subtract Cells That Change Weekly
Replies
4
Views
116
6StringJazzer
6StringJazzer
K
  • Solved
Find lottery 5_50 3rd price combinations from 12 numbers
Replies
9
Views
554
Kishan
K
M
  • Solved
Need help modify to pick any first number of my choice
Replies
6
Views
293
motilulla
M
E
  • Question
Dynamic small function
Replies
1
Views
206
KRice
K

Forum statistics

Threads
1,215,248
Messages
6,123,877
Members
449,130
Latest member
lolasmith

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top