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