' Generates Borders for Quadrant Bordered Magic Squares:
' Completes Border order 15, MC = 2175
' Completes Border order 17, MC = 2465
' Tested with Office 365 under Windows 10
Sub Priem15b()
Dim a(289)
Dim a1(120), b(289), c(289), b1(289)
y = MsgBox("Blocked", 0, "Priem5b")
End
k1 = 1: k2 = 1
m1 = 1:
Pr15 = 290: s1 = 2175
ShtNm1 = "CntrSqrs13b" 'Input (Partly Completed Centre Square)
GoSub 1500 'Read Border Variables and m2
Sheets("Klad1").Select
For j100 = 2 To 2 ''229 'Option: Patterns in Center Square
Cells(1, 1).Value = j100
Erase a
For i1 = 1 To 289 'Read available Square(s)
a(i1) = Sheets(ShtNm1).Cells(j100, i1).Value
If a(i1) <> 0 Then b(a(i1)) = a(i1)
Next i1
TagNr1 = Sheets(ShtNm1).Cells(j100, 291).Value
t11 = Timer 'Time Out
For j270 = m2 To m1 Step -1 'a(270)
If b(a1(j270)) = 0 Then b(a1(j270)) = a1(j270): c(270) = a1(j270) Else GoTo 2700
a(270) = a1(j270)
a(32) = Pr15 - a(270): If b(a(32)) = 0 Then b(a(32)) = a(32): c(32) = a(32) Else GoTo 320
For j269 = j270 - 1 To m1 Step -1 'a(269)
If b(a1(j269)) = 0 Then b(a1(j269)) = a1(j269): c(269) = a1(j269) Else GoTo 2690
a(269) = a1(j269)
a(31) = Pr15 - a(269): If b(a(31)) = 0 Then b(a(31)) = a(31): c(31) = a(31) Else GoTo 310
For j268 = j269 - 1 To m1 Step -1 'a(268)
If b(a1(j268)) = 0 Then b(a1(j268)) = a1(j268): c(268) = a1(j268) Else GoTo 2680
a(268) = a1(j268)
a(30) = Pr15 - a(268): If b(a(30)) = 0 Then b(a(30)) = a(30): c(30) = a(30) Else GoTo 300
For j267 = j268 - 1 To m1 Step -1 'a(267)
If b(a1(j267)) = 0 Then b(a1(j267)) = a1(j267): c(267) = a1(j267) Else GoTo 2670
a(267) = a1(j267)
a(29) = Pr15 - a(267): If b(a(29)) = 0 Then b(a(29)) = a(29): c(29) = a(29) Else GoTo 290
For j266 = j267 - 1 To m1 Step -1 'a(266)
If b(a1(j266)) = 0 Then b(a1(j266)) = a1(j266): c(266) = a1(j266) Else GoTo 2660
a(266) = a1(j266)
a(28) = Pr15 - a(266): If b(a(28)) = 0 Then b(a(28)) = a(28): c(28) = a(28) Else GoTo 280
For j262 = m1 To m2 'a(262)
If b(a1(j262)) = 0 Then b(a1(j262)) = a1(j262): c(262) = a1(j262) Else GoTo 2620
a(262) = a1(j262)
a(24) = Pr15 - a(262): If b(a(24)) = 0 Then b(a(24)) = a(24): c(24) = a(24) Else GoTo 240
For j261 = j262 + 1 To m2 'a(261)
If b(a1(j261)) = 0 Then b(a1(j261)) = a1(j261): c(261) = a1(j261) Else GoTo 2610
a(261) = a1(j261)
a(23) = Pr15 - a(261): If b(a(23)) = 0 Then b(a(23)) = a(23): c(23) = a(23) Else GoTo 310
For j260 = j261 + 1 To m2 'a(260)
If b(a1(j260)) = 0 Then b(a1(j260)) = a1(j260): c(260) = a1(j260) Else GoTo 2600
a(260) = a1(j260)
a(22) = Pr15 - a(260): If b(a(22)) = 0 Then b(a(22)) = a(22): c(22) = a(22) Else GoTo 220
For j259 = j260 + 1 To m2 'a(259)
If b(a1(j259)) = 0 Then b(a1(j259)) = a1(j259): c(259) = a1(j259) Else GoTo 2590
a(259) = a1(j259)
a(21) = Pr15 - a(259): If b(a(21)) = 0 Then b(a(21)) = a(21): c(21) = a(21) Else GoTo 210
For j258 = j259 + 1 To m2 'a(258)
If b(a1(j258)) = 0 Then b(a1(j258)) = a1(j258): c(258) = a1(j258) Else GoTo 2580
a(258) = a1(j258)
a(20) = Pr15 - a(258): If b(a(20)) = 0 Then b(a(20)) = a(20): c(20) = a(20) Else GoTo 200
a(264) = s1 - a(257) - a(258) - a(259) - a(260) - a(261) - a(262) - a(263) - a(265) - a(266) - a(267) - a(268) - a(269) - a(270) - a(271)
If a(264) < a1(m1) Or a(264) > a1(m2) Then GoTo 2640
If b1(a(264)) = 0 Then GoTo 2640
If b(a(264)) = 0 Then b(a(264)) = a(264): c(264) = a(264) Else GoTo 2640
a(26) = Pr15 - a(264): If b(a(26)) = 0 Then b(a(26)) = a(26): c(26) = a(26) Else GoTo 260
For j254 = m2 To m1 Step -1 'a(254)
If b(a1(j254)) = 0 Then b(a1(j254)) = a1(j254): c(254) = a1(j254) Else GoTo 2540
a(254) = a1(j254)
a(240) = Pr15 - a(254): If b(a(240)) = 0 Then b(a(240)) = a(240): c(240) = a(240) Else GoTo 2400
For j237 = j254 - 1 To m1 Step -1 'a(237)
If b(a1(j237)) = 0 Then b(a1(j237)) = a1(j237): c(237) = a1(j237) Else GoTo 2370
a(237) = a1(j237)
a(223) = Pr15 - a(237): If b(a(223)) = 0 Then b(a(223)) = a(223): c(223) = a(223) Else GoTo 2230
For j220 = j237 - 1 To m1 Step -1 'a(220)
If b(a1(j220)) = 0 Then b(a1(j220)) = a1(j220): c(220) = a1(j220) Else GoTo 2200
a(220) = a1(j220)
a(206) = Pr15 - a(220): If b(a(206)) = 0 Then b(a(206)) = a(206): c(206) = a(206) Else GoTo 2060
For j203 = j220 - 1 To m1 Step -1 'a(203)
If b(a1(j203)) = 0 Then b(a1(j203)) = a1(j203): c(203) = a1(j203) Else GoTo 2030
a(203) = a1(j203)
a(189) = Pr15 - a(203): If b(a(189)) = 0 Then b(a(189)) = a(189): c(189) = a(189) Else GoTo 1890
For j186 = j203 - 1 To m1 Step -1 'a(186)
If b(a1(j186)) = 0 Then b(a1(j186)) = a1(j186): c(186) = a1(j186) Else GoTo 1860
a(186) = a1(j186)
a(172) = Pr15 - a(186): If b(a(172)) = 0 Then b(a(172)) = a(172): c(172) = a(172) Else GoTo 1720
For j118 = m1 To m2 'a(118)
If b(a1(j118)) = 0 Then b(a1(j118)) = a1(j118): c(118) = a1(j118) Else GoTo 1180
a(118) = a1(j118)
a(104) = Pr15 - a(118): If b(a(104)) = 0 Then b(a(104)) = a(104): c(104) = a(104) Else GoTo 1040
For j101 = j118 + 1 To m2 'a(101)
If b(a1(j101)) = 0 Then b(a1(j101)) = a1(j101): c(101) = a1(j101) Else GoTo 1010
a(101) = a1(j101)
a(87) = Pr15 - a(101): If b(a(87)) = 0 Then b(a(87)) = a(87): c(87) = a(87) Else GoTo 870
For j84 = j101 + 1 To m2 'a(84)
If b(a1(j84)) = 0 Then b(a1(j84)) = a1(j84): c(84) = a1(j84) Else GoTo 840
a(84) = a1(j84)
a(70) = Pr15 - a(84): If b(a(70)) = 0 Then b(a(70)) = a(70): c(70) = a(70) Else GoTo 700
For j67 = j84 + 1 To m2 'a(67)
If b(a1(j67)) = 0 Then b(a1(j67)) = a1(j67): c(67) = a1(j67) Else GoTo 670
a(67) = a1(j67)
a(53) = Pr15 - a(67): If b(a(53)) = 0 Then b(a(53)) = a(53): c(53) = a(53) Else GoTo 530
For j50 = j67 + 1 To m2 'a(50)
If b(a1(j50)) = 0 Then b(a1(j50)) = a1(j50): c(50) = a1(j50) Else GoTo 500
a(50) = a1(j50)
a(36) = Pr15 - a(50): If b(a(36)) = 0 Then b(a(36)) = a(36): c(36) = a(36) Else GoTo 360
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Erase b, c: GoTo 1000 'Time Out, Try Next
a(152) = s1 - a(33) - a(50) - a(67) - a(84) - a(101) - a(118) - a(135) - a(169) - a(186) - a(203) - a(220) - a(237) - a(254) - a(271)
If a(152) < a1(m1) Or a(152) > a1(m2) Then GoTo 1520
If b1(a(152)) = 0 Then GoTo 1520
If b(a(152)) = 0 Then b(a(152)) = a(152): c(152) = a(152) Else GoTo 1520
a(138) = Pr15 - a(152): If b(a(138)) = 0 Then b(a(138)) = a(138): c(138) = a(138) Else GoTo 1380
GoSub 2500 'Add Fixed Border
GoSub 1300: If fl1 = 0 Then GoTo 5 'Check identical numbers (Back Check)
n9 = n9 + 1: GoSub 1670 'Print Square
Erase a, b, c: GoTo 1000 'Print first square for j100
5
b(c(138)) = 0: c(138) = 0
1380 b(c(152)) = 0: c(152) = 0
1520
b(c(36)) = 0: c(36) = 0
360 b(c(50)) = 0: c(50) = 0
500 Next j50
b(c(53)) = 0: c(53) = 0
530 b(c(67)) = 0: c(67) = 0
670 Next j67
b(c(70)) = 0: c(70) = 0
700 b(c(84)) = 0: c(84) = 0
840 Next j84
b(c(87)) = 0: c(87) = 0
870 b(c(101)) = 0: c(101) = 0
1010 Next j101
b(c(104)) = 0: c(104) = 0
1040 b(c(118)) = 0: c(118) = 0
1180 Next j118
b(c(172)) = 0: c(172) = 0
1720 b(c(186)) = 0: c(186) = 0
1860 Next j186
b(c(189)) = 0: c(189) = 0
1890 b(c(203)) = 0: c(203) = 0
2030 Next j203
b(c(206)) = 0: c(206) = 0
2060 b(c(220)) = 0: c(220) = 0
2200 Next j220
b(c(223)) = 0: c(223) = 0
2230 b(c(237)) = 0: c(237) = 0
2370 Next j237
b(c(240)) = 0: c(240) = 0
2400 b(c(254)) = 0: c(254) = 0
2540 Next j254
b(c(26)) = 0: c(26) = 0
260 b(c(264)) = 0: c(264) = 0
2640
b(c(20)) = 0: c(20) = 0
200 b(c(258)) = 0: c(258) = 0
2580 Next j258
b(c(21)) = 0: c(21) = 0
210 b(c(259)) = 0: c(259) = 0
2590 Next j259
b(c(22)) = 0: c(22) = 0
220 b(c(260)) = 0: c(260) = 0
2600 Next j260
b(c(23)) = 0: c(23) = 0
230 b(c(261)) = 0: c(261) = 0
2610 Next j261
b(c(24)) = 0: c(24) = 0
240 b(c(262)) = 0: c(262) = 0
2620 Next j262
b(c(28)) = 0: c(28) = 0
280 b(c(266)) = 0: c(266) = 0
2660 Next j266
b(c(29)) = 0: c(29) = 0
290 b(c(267)) = 0: c(267) = 0
2670 Next j267
b(c(30)) = 0: c(30) = 0
300 b(c(268)) = 0: c(268) = 0
2680 Next j268
b(c(31)) = 0: c(31) = 0
310 b(c(269)) = 0: c(269) = 0
2690 Next j269
b(c(32)) = 0: c(32) = 0
320 b(c(270)) = 0: c(270) = 0
2700 Next j270
1000 Next j100
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine Priem15b")
End
' Read Border Variables
1500 m2 = 56
a1(1) = 19: a1(2) = 20: a1(3) = 21: a1(4) = 22: a1(5) = 23: a1(6) = 24: a1(7) = 25: a1(8) = 26:
a1(9) = 27: a1(10) = 28: a1(11) = 29: a1(12) = 30: a1(13) = 31: a1(14) = 32: a1(15) = 33: a1(16) = 36:
a1(17) = 50: a1(18) = 53: a1(19) = 67: a1(20) = 70: a1(21) = 84: a1(22) = 87: a1(23) = 101: a1(24) = 104:
a1(25) = 118: a1(26) = 121: a1(27) = 135: a1(28) = 138: a1(29) = 152: a1(30) = 155: a1(31) = 169: a1(32) = 172:
a1(33) = 186: a1(34) = 189: a1(35) = 203: a1(36) = 206: a1(37) = 220: a1(38) = 223: a1(39) = 237: a1(40) = 240:
a1(41) = 254: a1(42) = 257: a1(43) = 258: a1(44) = 259: a1(45) = 260: a1(46) = 261: a1(47) = 262: a1(48) = 263:
a1(49) = 264: a1(50) = 265: a1(51) = 266: a1(52) = 267: a1(53) = 268: a1(54) = 269: a1(55) = 270: a1(56) = 271:
For i1 = 1 To m2
x = a1(i1): b1(x) = x
Next i1
Return
' Read Fixed Border (17 x 17)
2500
a(1) = 9: a(2) = 2: a(3) = 3: a(4) = 4: a(5) = 277: a(6) = 278: a(7) = 279:
a(8) = 280: a(9) = 282: a(10) = 283: a(11) = 284: a(12) = 285: a(13) = 14: a(14) = 15:
a(15) = 16: a(16) = 17: a(17) = 137:
a(18) = 18: a(34) = 272:
a(35) = 35: a(51) = 255:
a(52) = 52: a(68) = 238:
a(69) = 69: a(85) = 221:
a(86) = 102: a(102) = 188:
a(103) = 119: a(119) = 171:
a(120) = 136: a(136) = 154:
a(137) = 170: a(153) = 120:
a(154) = 187: a(170) = 103:
a(171) = 204: a(187) = 86:
a(188) = 205: a(204) = 85:
a(205) = 222: a(221) = 68:
a(222) = 239: a(238) = 51:
a(239) = 256: a(255) = 34:
a(256) = 289: a(272) = 1:
a(273) = 153: a(274) = 288: a(275) = 287: a(276) = 286: a(277) = 13: a(278) = 12: a(279) = 11:
a(280) = 10: a(281) = 8: a(282) = 7: a(283) = 6: a(284) = 5: a(285) = 276: a(286) = 275:
a(287) = 274: a(288) = 273: a(289) = 281:
Return
' Print a(), squares
1670 n1 = n1 + 1
If n1 = 2 Then
n1 = 1: k1 = k1 + 18: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 18
End If
Cells(2, 1).Value = n9
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 17
For i2 = 1 To 17
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
' Check Identical Numbers a()
1300 fl1 = 1
For i1 = 1 To 289
a20 = a(i1): If a20 = 0 Then GoTo 1310
For i2 = (1 + i1) To 289
If a20 = a(i2) Then fl1 = 0: Return
Next i2
1310 Next i1
Return
End Sub
