' Generates Inlaid Magic Squares of order 21
' Based on Order 7 Magic Sub Squares with Different Magic Sums
' Tested with Office 2007 under Windows 7
Sub Priem21k2()
Dim a1(750), a(225), a7(49), a21(441), b1(45355), b(45355), c(49)
y = MsgBox("Locked", vbCritical, "Routine Priem21k2")
End
n1 = 0: n9 = 0: n10 = 0: k1 = 1: k2 = 1
Sheets("Klad1").Select
t1 = Timer
For j201 = 100 To 200 ''2 To 965
j200 = Sheets("Partly21").Cells(j201, 227).Value
MC15 = Sheets("Partly21").Cells(j201, 226).Value
s15 = Sheets("Input9").Cells(j200, 20).Value
s21 = 21 * s15 / 15
If MC15 <> s15 Then
y = MsgBox("Discrepancy in Input", 0, "Priem21k2")
End
End If
Erase a21
For i1 = 1 To 225
a(i1) = Sheets("Partly21").Cells(j201, i1).Value
Next i1
GoSub 700 'Assign to a21() Step 1
Erase a
For j101 = 11 To 19
j100 = Sheets("Input9").Cells(j200, j101).Value
' Define variables
Cntr3 = Sheets("Pairs7").Cells(j100, 6).Value 'Center Element
Pr3 = 2 * Cntr3
s3 = 3 * Cntr3
s4 = 2 * Pr3
nVar1 = Sheets("Pairs7").Cells(j100, 9).Value
For i1 = 1 To nVar1
a1(i1) = Sheets("Pairs7").Cells(j100, 9 + i1).Value
Next i1
m1 = 1: m2 = nVar1
If a1(1) = 1 Then m1 = 2: m2 = m2 - 1
Erase b1
For i1 = m1 To m2
b1(a1(i1)) = a1(i1)
Next i1
' Remove Used Primes
For i1 = 1 To 441
b1(a21(i1)) = 0
Next i1
' Generate Border Concentric Magic Squares (7 * 7)
For j1 = m1 To m2
If b1(a1(j1)) = 0 Then GoTo 10
If b(a1(j1)) = 0 Then b(a1(j1)) = a1(j1): c(1) = a1(j1) Else GoTo 10
a(1) = a1(j1)
a(5) = Pr3 - a(1):
If a(5) < a1(m1) Or a(5) > a1(m2) Then GoTo 50:
If b1(a(5)) = 0 Then GoTo 50
If b(a(5)) = 0 Then b(a(5)) = a(5): c(5) = a(5) Else GoTo 50
For j2 = m1 To m2
If b1(a1(j2)) = 0 Then GoTo 20
If b(a1(j2)) = 0 Then b(a1(j2)) = a1(j2): c(2) = a1(j2) Else GoTo 20
a(2) = a1(j2)
a(6) = Pr3 - a(2):
If a(6) < a1(m1) Or a(6) > a1(m2) Then GoTo 60:
If b1(a(6)) = 0 Then GoTo 60
If b(a(6)) = 0 Then b(a(6)) = a(6): c(6) = a(6) Else GoTo 60
For j3 = m1 To m2
If b1(a1(j3)) = 0 Then GoTo 30
If b(a1(j3)) = 0 Then b(a1(j3)) = a1(j3): c(3) = a1(j3) Else GoTo 30
a(3) = a1(j3)
a(7) = Pr3 - a(3):
If a(7) < a1(m1) Or a(7) > a1(m2) Then GoTo 70:
If b1(a(7)) = 0 Then GoTo 70
If b(a(7)) = 0 Then b(a(7)) = a(7): c(7) = a(7) Else GoTo 70
a(4) = s4 - a(3) - a(2) - a(1)
If a(4) < a1(m1) Or a(4) > a1(m2) Then GoTo 40:
If b1(a(4)) = 0 Then GoTo 40
If b(a(4)) = 0 Then b(a(4)) = a(4): c(4) = a(4) Else GoTo 40
a(8) = Pr3 - a(4):
If a(8) < a1(m1) Or a(8) > a1(m2) Then GoTo 80:
If b1(a(8)) = 0 Then GoTo 80
If b(a(8)) = 0 Then b(a(8)) = a(8): c(8) = a(8) Else GoTo 80
For j9 = m1 To m2
If b1(a1(j9)) = 0 Then GoTo 90
If b(a1(j9)) = 0 Then b(a1(j9)) = a1(j9): c(9) = a1(j9) Else GoTo 90
a(9) = a1(j9)
a(12) = Pr3 - a(9):
If a(12) < a1(m1) Or a(12) > a1(m2) Then GoTo 120:
If b1(a(12)) = 0 Then GoTo 120
If b(a(12)) = 0 Then b(a(12)) = a(12): c(12) = a(12) Else GoTo 120
For j10 = m1 To m2
If b1(a1(j10)) = 0 Then GoTo 100
If b(a1(j10)) = 0 Then b(a1(j10)) = a1(j10): c(10) = a1(j10) Else GoTo 100
a(10) = a1(j10)
a(13) = Pr3 - a(10):
If a(13) < a1(m1) Or a(13) > a1(m2) Then GoTo 130:
If b1(a(13)) = 0 Then GoTo 130
If b(a(13)) = 0 Then b(a(13)) = a(13): c(13) = a(13) Else GoTo 130
a(11) = s4 - a(10) - a(9) - a(1)
If a(11) < a1(m1) Or a(11) > a1(m2) Then GoTo 110:
If b1(a(11)) = 0 Then GoTo 110
If b(a(11)) = 0 Then b(a(11)) = a(11): c(11) = a(11) Else GoTo 110
a(14) = Pr3 - a(11):
If a(14) < a1(m1) Or a(14) > a1(m2) Then GoTo 140:
If b1(a(14)) = 0 Then GoTo 140
If b(a(14)) = 0 Then b(a(14)) = a(14): c(14) = a(14) Else GoTo 140
a7(4) = a(4): a7(5) = a(3): a7(6) = a(2): a7(7) = a(1):
a7(43) = a(5): a7(46) = a(8): a7(47) = a(7): a7(48) = a(6):
a7(8) = a(12): a7(14) = a(9):
a7(15) = a(13): a7(21) = a(10):
a7(22) = a(14): a7(28) = a(11):
For j15 = m1 To m2
If b1(a1(j15)) = 0 Then GoTo 150
If b(a1(j15)) = 0 Then b(a1(j15)) = a1(j15): c(15) = a1(j15) Else GoTo 150
a(15) = a1(j15)
a(18) = Pr3 - a(15):
If a(18) < a1(m1) Or a(18) > a1(m2) Then GoTo 180:
If b1(a(18)) = 0 Then GoTo 180
If b(a(18)) = 0 Then b(a(18)) = a(18): c(18) = a(18) Else GoTo 180
For j16 = m1 To m2
If b1(a1(j16)) = 0 Then GoTo 160
If b(a1(j16)) = 0 Then b(a1(j16)) = a1(j16): c(16) = a1(j16) Else GoTo 160
a(16) = a1(j16)
a(19) = Pr3 - a(16):
If a(19) < a1(m1) Or a(19) > a1(m2) Then GoTo 190:
If b1(a(19)) = 0 Then GoTo 190
If b(a(19)) = 0 Then b(a(19)) = a(19): c(19) = a(19) Else GoTo 190
a(17) = s3 - a(16) - a(15)
If a(17) < a1(m1) Or a(17) > a1(m2) Then GoTo 170:
If b1(a(17)) = 0 Then GoTo 170
If b(a(17)) = 0 Then b(a(17)) = a(17): c(17) = a(17) Else GoTo 170
a(20) = Pr3 - a(17):
If a(20) < a1(m1) Or a(20) > a1(m2) Then GoTo 200:
If b1(a(20)) = 0 Then GoTo 200
If b(a(20)) = 0 Then b(a(20)) = a(20): c(20) = a(20) Else GoTo 200
For j21 = m1 To m2
If b1(a1(j21)) = 0 Then GoTo 210
If b(a1(j21)) = 0 Then b(a1(j21)) = a1(j21): c(21) = a1(j21) Else GoTo 210
a(21) = a1(j21)
a(23) = Pr3 - a(21):
If a(23) < a1(m1) Or a(23) > a1(m2) Then GoTo 230:
If b1(a(23)) = 0 Then GoTo 230
If b(a(23)) = 0 Then b(a(23)) = a(23): c(23) = a(23) Else GoTo 230
a(22) = s3 - a(21) - a(20)
If a(22) < a1(m1) Or a(22) > a1(m2) Then GoTo 220:
If b1(a(22)) = 0 Then GoTo 220
If b(a(22)) = 0 Then b(a(22)) = a(22): c(22) = a(22) Else GoTo 220
a(24) = Pr3 - a(22):
If a(24) < a1(m1) Or a(24) > a1(m2) Then GoTo 240:
If b1(a(24)) = 0 Then GoTo 240
If b(a(24)) = 0 Then b(a(24)) = a(24): c(24) = a(24) Else GoTo 240
a7(1) = a(17): a7(2) = a(16): a7(3) = a(15):
a7(44) = a(19): a7(45) = a(18): a7(49) = a(20):
a7(29) = a(24): a7(35) = a(22):
a7(36) = a(23): a7(42) = a(21):
GoSub 800: If fl1 = 0 Then GoTo 75
For i1 = 1 To 49: a(i1) = a7(i1): Next i1
Erase a7
n10 = n10 + 1: GoSub 750 'Assign to a21()
Erase b, c: GoTo 5 'Assign only first square
75
b(c(24)) = 0: c(24) = 0
240 b(c(22)) = 0: c(22) = 0
220 b(c(23)) = 0: c(23) = 0
230 b(c(21)) = 0: c(21) = 0
210 Next j21
b(c(20)) = 0: c(20) = 0
200 b(c(17)) = 0: c(17) = 0
170 b(c(19)) = 0: c(19) = 0
190 b(c(16)) = 0: c(16) = 0
160 Next j16
b(c(18)) = 0: c(18) = 0
180 b(c(15)) = 0: c(15) = 0
150 Next j15
b(c(14)) = 0: c(14) = 0
140 b(c(11)) = 0: c(11) = 0
110 b(c(13)) = 0: c(13) = 0
130 b(c(10)) = 0: c(10) = 0
100 Next j10
b(c(12)) = 0: c(12) = 0
120 b(c(9)) = 0: c(9) = 0
90 Next j9
b(c(8)) = 0: c(8) = 0
80 b(c(4)) = 0: c(4) = 0
40 b(c(7)) = 0: c(7) = 0
70 b(c(3)) = 0: c(3) = 0
30 Next j3
b(c(6)) = 0: c(6) = 0
60 b(c(2)) = 0: c(2) = 0
20 Next j2
b(c(5)) = 0: c(5) = 0
50 b(c(1)) = 0: c(1) = 0
10 Next j1
' Not found
Erase b, c: n10 = 0: GoTo 2000
5
If n10 = 9 Then
GoSub 850:
If fl1 = 1 Then
n9 = n9 + 1: GoSub 660 'Print results (squares)
If n9 = 8 Then End
n10 = 0: GoTo 2000
End If
End If
Next j101
2000 n10 = 0
Next j201
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
y = MsgBox(t10, 0, "Routine Priem21k2")
End
' Assign to a21()
' Step 1
700 a21(23) = a(1): a21(24) = a(2): a21(25) = a(3): a21(26) = a(4): a21(27) = a(5):
a21(44) = a(16): a21(45) = a(17): a21(46) = a(18): a21(47) = a(19): a21(48) = a(20):
a21(65) = a(31): a21(66) = a(32): a21(67) = a(33): a21(68) = a(34): a21(69) = a(35):
a21(86) = a(46): a21(87) = a(47): a21(88) = a(48): a21(89) = a(49): a21(90) = a(50):
a21(107) = a(61): a21(108) = a(62): a21(109) = a(63): a21(110) = a(64): a21(111) = a(65):
a21(30) = a(6): a21(31) = a(7): a21(32) = a(8): a21(33) = a(9): a21(34) = a(10):
a21(51) = a(21): a21(52) = a(22): a21(53) = a(23): a21(54) = a(24): a21(55) = a(25):
a21(72) = a(36): a21(73) = a(37): a21(74) = a(38): a21(75) = a(39): a21(76) = a(40):
a21(93) = a(51): a21(94) = a(52): a21(95) = a(53): a21(96) = a(54): a21(97) = a(55):
a21(114) = a(66): a21(115) = a(67): a21(116) = a(68): a21(117) = a(69): a21(118) = a(70):
a21(37) = a(11): a21(38) = a(12): a21(39) = a(13): a21(40) = a(14): a21(41) = a(15):
a21(58) = a(26): a21(59) = a(27): a21(60) = a(28): a21(61) = a(29): a21(62) = a(30):
a21(79) = a(41): a21(80) = a(42): a21(81) = a(43): a21(82) = a(44): a21(83) = a(45):
a21(100) = a(56): a21(101) = a(57): a21(102) = a(58): a21(103) = a(59): a21(104) = a(60):
a21(121) = a(71): a21(122) = a(72): a21(123) = a(73): a21(124) = a(74): a21(125) = a(75):
a21(170) = a(76): a21(171) = a(77): a21(172) = a(78): a21(173) = a(79): a21(174) = a(80):
a21(191) = a(91): a21(192) = a(92): a21(193) = a(93): a21(194) = a(94): a21(195) = a(95):
a21(212) = a(106): a21(213) = a(107): a21(214) = a(108): a21(215) = a(109): a21(216) = a(110):
a21(233) = a(121): a21(234) = a(122): a21(235) = a(123): a21(236) = a(124): a21(237) = a(125):
a21(254) = a(136): a21(255) = a(137): a21(256) = a(138): a21(257) = a(139): a21(258) = a(140):
a21(177) = a(81): a21(178) = a(82): a21(179) = a(83): a21(180) = a(84): a21(181) = a(85):
a21(198) = a(96): a21(199) = a(97): a21(200) = a(98): a21(201) = a(99): a21(202) = a(100):
a21(219) = a(111): a21(220) = a(112): a21(221) = a(113): a21(222) = a(114): a21(223) = a(115):
a21(240) = a(126): a21(241) = a(127): a21(242) = a(128): a21(243) = a(129): a21(244) = a(130):
a21(261) = a(141): a21(262) = a(142): a21(263) = a(143): a21(264) = a(144): a21(265) = a(145):
a21(184) = a(86): a21(185) = a(87): a21(186) = a(88): a21(187) = a(89): a21(188) = a(90):
a21(205) = a(101): a21(206) = a(102): a21(207) = a(103): a21(208) = a(104): a21(209) = a(105):
a21(226) = a(116): a21(227) = a(117): a21(228) = a(118): a21(229) = a(119): a21(230) = a(120):
a21(247) = a(131): a21(248) = a(132): a21(249) = a(133): a21(250) = a(134): a21(251) = a(135):
a21(268) = a(146): a21(269) = a(147): a21(270) = a(148): a21(271) = a(149): a21(272) = a(150):
a21(317) = a(151): a21(318) = a(152): a21(319) = a(153): a21(320) = a(154): a21(321) = a(155):
a21(338) = a(166): a21(339) = a(167): a21(340) = a(168): a21(341) = a(169): a21(342) = a(170):
a21(359) = a(181): a21(360) = a(182): a21(361) = a(183): a21(362) = a(184): a21(363) = a(185):
a21(380) = a(196): a21(381) = a(197): a21(382) = a(198): a21(383) = a(199): a21(384) = a(200):
a21(401) = a(211): a21(402) = a(212): a21(403) = a(213): a21(404) = a(214): a21(405) = a(215):
a21(324) = a(156): a21(325) = a(157): a21(326) = a(158): a21(327) = a(159): a21(328) = a(160):
a21(345) = a(171): a21(346) = a(172): a21(347) = a(173): a21(348) = a(174): a21(349) = a(175):
a21(366) = a(186): a21(367) = a(187): a21(368) = a(188): a21(369) = a(189): a21(370) = a(190):
a21(387) = a(201): a21(388) = a(202): a21(389) = a(203): a21(390) = a(204): a21(391) = a(205):
a21(408) = a(216): a21(409) = a(217): a21(410) = a(218): a21(411) = a(219): a21(412) = a(220):
a21(331) = a(161): a21(332) = a(162): a21(333) = a(163): a21(334) = a(164): a21(335) = a(165):
a21(352) = a(176): a21(353) = a(177): a21(354) = a(178): a21(355) = a(179): a21(356) = a(180):
a21(373) = a(191): a21(374) = a(192): a21(375) = a(193): a21(376) = a(194): a21(377) = a(195):
a21(394) = a(206): a21(395) = a(207): a21(396) = a(208): a21(397) = a(209): a21(398) = a(210):
a21(415) = a(221): a21(416) = a(222): a21(417) = a(223): a21(418) = a(224): a21(419) = a(225):
Return
' Step 2
750 Select Case n10
Case 1
a21(1) = a(1): a21(2) = a(2): a21(3) = a(3): a21(4) = a(4): a21(5) = a(5): a21(6) = a(6): a21(7) = a(7):
a21(22) = a(8): a21(28) = a(14):
a21(43) = a(15): a21(49) = a(21):
a21(64) = a(22): a21(70) = a(28):
a21(85) = a(29): a21(91) = a(35):
a21(106) = a(36): a21(112) = a(42):
a21(127) = a(43): a21(128) = a(44): a21(129) = a(45): a21(130) = a(46): a21(131) = a(47): a21(132) = a(48): a21(133) = a(49):
Case 2
a21(8) = a(1): a21(9) = a(2): a21(10) = a(3): a21(11) = a(4): a21(12) = a(5): a21(13) = a(6): a21(14) = a(7):
a21(29) = a(8): a21(35) = a(14):
a21(50) = a(15): a21(56) = a(21):
a21(71) = a(22): a21(77) = a(28):
a21(92) = a(29): a21(98) = a(35):
a21(113) = a(36): a21(119) = a(42):
a21(134) = a(43): a21(135) = a(44): a21(136) = a(45): a21(137) = a(46): a21(138) = a(47): a21(139) = a(48): a21(140) = a(49):
Case 3
a21(15) = a(1): a21(16) = a(2): a21(17) = a(3): a21(18) = a(4): a21(19) = a(5): a21(20) = a(6): a21(21) = a(7):
a21(36) = a(8): a21(42) = a(14):
a21(57) = a(15): a21(63) = a(21):
a21(78) = a(22): a21(84) = a(28):
a21(99) = a(29): a21(105) = a(35):
a21(120) = a(36): a21(126) = a(42):
a21(141) = a(43): a21(142) = a(44): a21(143) = a(45): a21(144) = a(46): a21(145) = a(47): a21(146) = a(48): a21(147) = a(49):
Case 4
a21(148) = a(1): a21(149) = a(2): a21(150) = a(3): a21(151) = a(4): a21(152) = a(5): a21(153) = a(6): a21(154) = a(7):
a21(169) = a(8): a21(175) = a(14):
a21(190) = a(15): a21(196) = a(21):
a21(211) = a(22): a21(217) = a(28):
a21(232) = a(29): a21(238) = a(35):
a21(253) = a(36): a21(259) = a(42):
a21(274) = a(43): a21(275) = a(44): a21(276) = a(45): a21(277) = a(46): a21(278) = a(47): a21(279) = a(48): a21(280) = a(49):
Case 5
a21(155) = a(1): a21(156) = a(2): a21(157) = a(3): a21(158) = a(4): a21(159) = a(5): a21(160) = a(6): a21(161) = a(7):
a21(176) = a(8): a21(182) = a(14):
a21(197) = a(15): a21(203) = a(21):
a21(218) = a(22): a21(224) = a(28):
a21(239) = a(29): a21(245) = a(35):
a21(260) = a(36): a21(266) = a(42):
a21(281) = a(43): a21(282) = a(44): a21(283) = a(45): a21(284) = a(46): a21(285) = a(47): a21(286) = a(48): a21(287) = a(49):
Case 6
a21(162) = a(1): a21(163) = a(2): a21(164) = a(3): a21(165) = a(4): a21(166) = a(5): a21(167) = a(6): a21(168) = a(7):
a21(183) = a(8): a21(189) = a(14):
a21(204) = a(15): a21(210) = a(21):
a21(225) = a(22): a21(231) = a(28):
a21(246) = a(29): a21(252) = a(35):
a21(267) = a(36): a21(273) = a(42):
a21(288) = a(43): a21(289) = a(44): a21(290) = a(45): a21(291) = a(46): a21(292) = a(47): a21(293) = a(48): a21(294) = a(49):
Case 7
a21(295) = a(1): a21(296) = a(2): a21(297) = a(3): a21(298) = a(4): a21(299) = a(5): a21(300) = a(6): a21(301) = a(7):
a21(316) = a(8): a21(322) = a(14):
a21(337) = a(15): a21(343) = a(21):
a21(358) = a(22): a21(364) = a(28):
a21(379) = a(29): a21(385) = a(35):
a21(400) = a(36): a21(406) = a(42):
a21(421) = a(43): a21(422) = a(44): a21(423) = a(45): a21(424) = a(46): a21(425) = a(47): a21(426) = a(48): a21(427) = a(49):
Case 8
a21(302) = a(1): a21(303) = a(2): a21(304) = a(3): a21(305) = a(4): a21(306) = a(5): a21(307) = a(6): a21(308) = a(7):
a21(323) = a(8): a21(329) = a(14):
a21(344) = a(15): a21(350) = a(21):
a21(365) = a(22): a21(371) = a(28):
a21(386) = a(29): a21(392) = a(35):
a21(407) = a(36): a21(413) = a(42):
a21(428) = a(43): a21(429) = a(44): a21(430) = a(45): a21(431) = a(46): a21(432) = a(47): a21(433) = a(48): a21(434) = a(49):
Case 9
a21(309) = a(1): a21(310) = a(2): a21(311) = a(3): a21(312) = a(4): a21(313) = a(5): a21(314) = a(6): a21(315) = a(7):
a21(330) = a(8): a21(336) = a(14):
a21(351) = a(15): a21(357) = a(21):
a21(372) = a(22): a21(378) = a(28):
a21(393) = a(29): a21(399) = a(35):
a21(414) = a(36): a21(420) = a(42):
a21(435) = a(43): a21(436) = a(44): a21(437) = a(45): a21(438) = a(46): a21(439) = a(47): a21(440) = a(48): a21(441) = a(49):
End Select
Return
' Print results: squares a21()
660 n1 = n1 + 1
If n1 = 2 Then
n1 = 1: k1 = k1 + 22: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 22
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = s21
i3 = 0
For i1 = 1 To 21
For i2 = 1 To 21
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a21(i3)
Next i2
Next i1
Return
' Exclude solutions with identical numbers a()
800 fl1 = 1
For j1 = 1 To 49
a2 = a7(j1): If a2 = 0 Then GoTo 810
For j2 = (1 + j1) To 49
If a2 = a7(j2) Then fl1 = 0: Return
Next j2
810 Next j1
Return
' Exclude solutions with identical numbers a21()
850 fl1 = 1
For j1 = 1 To 441
a2 = a21(j1): If a2 = 0 Then GoTo 860
For j2 = (1 + j1) To 441
If a2 = a21(j2) Then fl1 = 0: Return
Next j2
860 Next j1
Return
End Sub
