Magic esquire 3x3

[motilulla]

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
	A	B	C	D	E	F
1
2
3	0		3	1	2
4	1		0	2	1
5	2		0	3	2
6	3
7	4		5	2	1
8	5		2	0	3
9	6		0	1	0
10	7
11	8		3	2	1
12			1	1	4
13			1	0	1
14
15			3	2	0
16			1	2	2
17			0	1	3
18
19			3	1	0
20			1	5	1
21			1	2	0
22
23			5	2	1
24			0	0	3
25			0	1	2
26
27			2	2	1
28			3	2	2
29			1	1	0
30
31			3	2	2
32			2	1	1
33			0	1	2
34
35			4	2	1
36			0	0	1
37			2	3	1
38
39			1	6	0
40			2	2	2
41			1	0	0
42
43			0	1	3
44			1	1	3
45			1	2	2
46
47			1	2	2
48			1	1	1
49			1	2	3
50
51			2	1	2
52			1	1	2
53			1	3	1
54
55			6	2	1
56			3	0	1
57			0	0	1
58
59
Sheet2

Thank you all
Excel 2000
Regards,
Moti

 

[motilulla]

what are you going to do with 308,187 permutations ?

oldbrewer, I need to check past results with all these permutations, is it possible to generate with all version 2000?

 

[motilulla]

Is it possible to generate all 308,187 permutations with my excel version 2000?

 

[motilulla]

Bump

 

[oldbrewer]

with a macro you can print the first 50000 in col A - the next 5000 in col B etc - would that suit ?

 

[motilulla]

with a macro you can print the first 50000 in col A - the next 5000 in col B etc - would that suit ?

Hello oldbrewer, that would be perfect, if it is possible?

Thank you

Regards,
Moti

 

[oldbrewer]

it is a lot of work to code - I cannot spare the time at present - try yourself - cycle A,B,C,D,E,F,G,H FROM 0 to 8 and if the total = 14 stores the values of A to H in an array - then print first 50000 values in col A - next 50000 in col B

to do this use

for j=1 to 7
for k = 1 to 50000
sum=sum+1
cells(j,k)= a(sum)&b(sum)&.......etc
next k
next j

 

[shg]

Sub moti()
  Const m           As Long = 9
  Const iTgt As Long = 14
  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 64000, 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 > iTgt Then Exit For
    Next i

    If iSum = iTgt Then
      n = n + 1

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

      If n >= 64000 Then
        Cells(1, Columns.Count).End(xlToLeft).Offset(, 2).Resize(n, 9).Value = aiOut
        Erase aiOut
        n = 0
      End If
      
      If (n And &H3FF&) = 0& Then
        Application.StatusBar = Format(n, "#,##0")
        DoEvents
      End If
    End If
  Loop

  If n Then Cells(1, Columns.Count).End(xlToLeft).Offset(, 2).Resize(n, 9).Value = aiOut
  
  Application.StatusBar = False
End Sub

The function remains is unchanged.

 

[motilulla]

Sub moti()
End Sub

The function remains is unchanged.

shg,Thank you so much for modifying the code to work with my version, I am away from my desk computer 3 days because I am out of city, will check on 17th and give you conformation


Have a nice day

Regards,
Moti

 

[motilulla]

shg,Thank you so much for modifying the code to work with my version, I am away from my desk computer 3 days because I am out of city, will check on 17th and give you conformation


Have a nice day

Regards,
Moti

Wow shg, code works like magic with my version, it took time 00:01:01 second to generate all 308,187 sets through C to AY columns

Many thanks for your kind help

Have a nice day

Good Luck

Kind Regards,
Moti

 

[shg]

You're welcome.