' Generates Inlaid Magic Squares of order 15, Integers 1 ... 225, Part I (Border)
' Tested with Office 365 under Windows 10
' Completess Inlaid Magic Squares of order 15, Integers 1 ... 225 (Border)
' Tested with Office 365 under Windows 11
Sub MgcSqr15k1()
Dim a1(225), a(225), b1(225), b(225), c(225), s(4)
Dim a11(169)
y = MsgBox("Locked", vbCritical, "Routine MgcSqr15k1")
End
n1 = 0: n2 = 0: n3 = 0: k1 = 1: k2 = 1: n9 = 0: n10 = 0
s1 = 1695: Pr15 = 226
' Generate Squares
Sheets("Klad1").Select
t1 = Timer
' Define Available Integers based on sheet 'Input13'
s(3) = Sheets("Input13").Cells(3, 16).Value
s(4) = Sheets("Input13").Cells(3, 17).Value
s(1) = 12 * s1 / 15 - s(4)
s(2) = 10 * s1 / 15 - s(3)
For i1 = 1 To 225 'Range
b1(i1) = i1
Next i1
i3 = 0 'Available Integers
For i1 = 2 To 14
For i2 = 2 To 14
a13 = Sheets("Input13").Cells(i1, i2).Value
b1(a13) = 0
Next i2
Next i1
For i1 = 1 To 225
If b1(i1) < > 0 Then
i3 = i3 + 1: a1(i3) = i1
End If
Next i1
m1 = 1: m2 = i3
' Create Border
t11 = Timer 'Time Out
' Border Rows
For j225 = 22 To m2 'a(225)
Cells(2, 1).Value = j225
If b(a1(j225)) = 0 Then b(a1(j225)) = a1(j225): c(225) = a1(j225) Else GoTo 2250
a(225) = a1(j225)
a(1) = 2 * s1 / 15 - a(225):
If b1(a(1)) = 0 Then GoTo 10
If b(a(1)) = 0 Then b(a(1)) = a(1): c(1) = a(1) Else GoTo 10
For j224 = m1 To m2 'a(224)
If b(a1(j224)) = 0 Then b(a1(j224)) = a1(j224): c(224) = a1(j224) Else GoTo 2240
a(224) = a1(j224)
a(212) = -s1 / 15 + a(224) - s(3) + s(4)
If a(212) < a1(m1) Or a(212) > a1(m2) Then GoTo 2120
If b1(a(212)) = 0 Then GoTo 2120
If b(a(212)) = 0 Then b(a(212)) = a(212): c(212) = a(212) Else GoTo 2120
a(14) = 2 * s1 / 15 - a(212):
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
a(2) = 2 * s1 / 15 - a(224):
If b1(a(2)) = 0 Then GoTo 20
If b(a(2)) = 0 Then b(a(2)) = a(2): c(2) = a(2) Else GoTo 20
For j223 = m1 To m2 'a(223)
If b(a1(j223)) = 0 Then b(a1(j223)) = a1(j223): c(223) = a1(j223) Else GoTo 2230
a(223) = a1(j223)
a(213) = -s1 / 15 + a(223) - s(3) + s(4)
If a(213) < a1(m1) Or a(213) > a1(m2) Then GoTo 2130
If b1(a(213)) = 0 Then GoTo 2130
If b(a(213)) = 0 Then b(a(213)) = a(213): c(213) = a(213) Else GoTo 2130
a(13) = 2 * s1 / 15 - a(213):
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(3) = 2 * s1 / 15 - a(223):
If b1(a(3)) = 0 Then GoTo 30
If b(a(3)) = 0 Then b(a(3)) = a(3): c(3) = a(3) Else GoTo 30
For j222 = m1 To m2 'a(222)
If b(a1(j222)) = 0 Then b(a1(j222)) = a1(j222): c(222) = a1(j222) Else GoTo 2220
a(222) = a1(j222)
a(214) = -s1 / 15 + a(222) - s(3) + s(4)
If a(214) < a1(m1) Or a(214) > a1(m2) Then GoTo 2140
If b1(a(214)) = 0 Then GoTo 2140
If b(a(214)) = 0 Then b(a(214)) = a(214): c(214) = a(214) Else GoTo 2140
a(12) = 2 * s1 / 15 - a(214):
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
a(4) = 2 * s1 / 15 - a(222):
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
For j221 = m1 To m2 'a(221)
If b(a1(j221)) = 0 Then b(a1(j221)) = a1(j221): c(221) = a1(j221) Else GoTo 2210
a(221) = a1(j221)
a(215) = -s1 / 15 + a(221) - s(3) + s(4)
If a(215) < a1(m1) Or a(215) > a1(m2) Then GoTo 2150
If b1(a(215)) = 0 Then GoTo 2150
If b(a(215)) = 0 Then b(a(215)) = a(215): c(215) = a(215) Else GoTo 2150
a(11) = 2 * s1 / 15 - a(215):
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(5) = 2 * s1 / 15 - a(221):
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 j220 = m1 To m2 '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(216) = -s1 / 15 + a(220) - s(3) + s(4)
If a(216) < a1(m1) Or a(216) > a1(m2) Then GoTo 2160
If b1(a(216)) = 0 Then GoTo 2160
If b(a(216)) = 0 Then b(a(216)) = a(216): c(216) = a(216) Else GoTo 2160
a(10) = 2 * s1 / 15 - a(216):
If b1(a(10)) = 0 Then GoTo 100
If b(a(10)) = 0 Then b(a(10)) = a(10): c(10) = a(10) Else GoTo 100
a(6) = 2 * s1 / 15 - a(220):
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 j219 = m1 To m2 'a(219)
If b(a1(j219)) = 0 Then b(a1(j219)) = a1(j219): c(219) = a1(j219) Else GoTo 2190
a(219) = a1(j219)
a(217) = -s1 / 15 + a(219) - s(3) + s(4)
If a(217) < a1(m1) Or a(217) > a1(m2) Then GoTo 2170
If b1(a(217)) = 0 Then GoTo 2170
If b(a(217)) = 0 Then b(a(217)) = a(217): c(217) = a(217) Else GoTo 2170
a(9) = 2 * s1 / 15 - a(217):
If b1(a(9)) = 0 Then GoTo 90
If b(a(9)) = 0 Then b(a(9)) = a(9): c(9) = a(9) Else GoTo 90
a(7) = 2 * s1 / 15 - a(219):
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
For j218 = m1 To m2 'a(218)
If b(a1(j218)) = 0 Then b(a1(j218)) = a1(j218): c(218) = a1(j218) Else GoTo 2180
a(218) = a1(j218)
a(211) = s1 - a(212) - a(213) - a(214) - a(215) - a(216) - a(217) - a(218) - a(219) - a(220) - a(221) +
- a(222) - a(223) - a(224) - a(225)
If a(211) < a1(m1) Or a(211) > a1(m2) Then GoTo 2110
If b1(a(211)) = 0 Then GoTo 2110
If b(a(211)) = 0 Then b(a(211)) = a(211): c(211) = a(211) Else GoTo 2110
a(15) = 2 * s1 / 15 - a(211):
If b1(a(15)) = 0 Then GoTo 150
If b(a(15)) = 0 Then b(a(15)) = a(15): c(15) = a(15) Else GoTo 150
a(8) = 2 * s1 / 15 - a(218):
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
' Border Columns
For j210 = m1 To m2 'a(210)
If b(a1(j210)) = 0 Then b(a1(j210)) = a1(j210): c(210) = a1(j210) Else GoTo 2100
a(210) = a1(j210)
a(196) = s1 - a(210) - s(3) - s(4)
If a(196) < a1(m1) Or a(196) > a1(m2) Then GoTo 1960
If b1(a(196)) = 0 Then GoTo 1960
If b(a(196)) = 0 Then b(a(196)) = a(196): c(196) = a(196) Else GoTo 1960
a(30) = 2 * s1 / 15 - a(196):
If b1(a(30)) = 0 Then GoTo 300
If b(a(30)) = 0 Then b(a(30)) = a(30): c(30) = a(30) Else GoTo 300
a(16) = 2 * s1 / 15 - a(210):
If b1(a(16)) = 0 Then GoTo 160
If b(a(16)) = 0 Then b(a(16)) = a(16): c(16) = a(16) Else GoTo 160
For j195 = m1 To m2 'a(195)
If b(a1(j195)) = 0 Then b(a1(j195)) = a1(j195): c(195) = a1(j195) Else GoTo 1950
a(195) = a1(j195)
a(181) = s1 - a(195) - s(3) - s(4)
If a(181) < a1(m1) Or a(181) > a1(m2) Then GoTo 1810
If b1(a(181)) = 0 Then GoTo 1810
If b(a(181)) = 0 Then b(a(181)) = a(181): c(181) = a(181) Else GoTo 1810
a(45) = 2 * s1 / 15 - a(181):
If b1(a(45)) = 0 Then GoTo 450
If b(a(45)) = 0 Then b(a(45)) = a(45): c(45) = a(45) Else GoTo 450
a(31) = 2 * s1 / 15 - a(195):
If b1(a(31)) = 0 Then GoTo 310
If b(a(31)) = 0 Then b(a(31)) = a(31): c(31) = a(31) Else GoTo 310
For j180 = m1 To m2 'a(180)
If b(a1(j180)) = 0 Then b(a1(j180)) = a1(j180): c(180) = a1(j180) Else GoTo 1800
a(180) = a1(j180)
a(166) = s1 - a(180) - s(3) - s(4)
If a(166) < a1(m1) Or a(166) > a1(m2) Then GoTo 1660
If b1(a(166)) = 0 Then GoTo 1660
If b(a(166)) = 0 Then b(a(166)) = a(166): c(166) = a(166) Else GoTo 1660
a(60) = 2 * s1 / 15 - a(166):
If b1(a(60)) = 0 Then GoTo 600
If b(a(60)) = 0 Then b(a(60)) = a(60): c(60) = a(60) Else GoTo 600
a(46) = 2 * s1 / 15 - a(180):
If b1(a(46)) = 0 Then GoTo 460
If b(a(46)) = 0 Then b(a(46)) = a(46): c(46) = a(46) Else GoTo 460
For j165 = m1 To m2 'a(165)
If b(a1(j165)) = 0 Then b(a1(j165)) = a1(j165): c(165) = a1(j165) Else GoTo 1650
a(165) = a1(j165)
a(151) = s1 - a(165) - s(3) - s(4)
If a(151) < a1(m1) Or a(151) > a1(m2) Then GoTo 1510
If b1(a(151)) = 0 Then GoTo 1510
If b(a(151)) = 0 Then b(a(151)) = a(151): c(151) = a(151) Else GoTo 1510
a(75) = 2 * s1 / 15 - a(151):
If b1(a(75)) = 0 Then GoTo 750
If b(a(75)) = 0 Then b(a(75)) = a(75): c(75) = a(75) Else GoTo 750
a(61) = 2 * s1 / 15 - a(165):
If b1(a(61)) = 0 Then GoTo 610
If b(a(61)) = 0 Then b(a(61)) = a(61): c(61) = a(61) Else GoTo 610
For j150 = m1 To m2 'a(150)
If b(a1(j150)) = 0 Then b(a1(j150)) = a1(j150): c(150) = a1(j150) Else GoTo 1500
a(150) = a1(j150)
a(136) = s1 - a(150) - s(3) - s(4)
If a(136) < a1(m1) Or a(136) > a1(m2) Then GoTo 1360
If b1(a(136)) = 0 Then GoTo 1360
If b(a(136)) = 0 Then b(a(136)) = a(136): c(136) = a(136) Else GoTo 1360
a(90) = 2 * s1 / 15 - a(136):
If b1(a(90)) = 0 Then GoTo 900
If b(a(90)) = 0 Then b(a(90)) = a(90): c(90) = a(90) Else GoTo 900
a(76) = 2 * s1 / 15 - a(150):
If b1(a(76)) = 0 Then GoTo 760
If b(a(76)) = 0 Then b(a(76)) = a(76): c(76) = a(76) Else GoTo 760
For j135 = m1 To m2 'a(135)
If b(a1(j135)) = 0 Then b(a1(j135)) = a1(j135): c(135) = a1(j135) Else GoTo 1350
a(135) = a1(j135)
a(121) = s1 - a(135) - s(3) - s(4)
If a(121) < a1(m1) Or a(121) > a1(m2) Then GoTo 1210
If b1(a(121)) = 0 Then GoTo 1210
If b(a(121)) = 0 Then b(a(121)) = a(121): c(121) = a(121) Else GoTo 1210
a(105) = 2 * s1 / 15 - a(121):
If b1(a(105)) = 0 Then GoTo 1050
If b(a(105)) = 0 Then b(a(105)) = a(105): c(105) = a(105) Else GoTo 1050
a(91) = 2 * s1 / 15 - a(135):
If b1(a(91)) = 0 Then GoTo 910
If b(a(91)) = 0 Then b(a(91)) = a(91): c(91) = a(91) Else GoTo 910
a(120) = s1 - a(15) - a(30) - a(45) - a(60) - a(75) - a(90) - a(105) - a(135) - a(150) - a(165) +
- a(180) - a(195) - a(210) - a(225)
If a(120) < a1(m1) Or a(120) > a1(m2) Then GoTo 1200
If b1(a(120)) = 0 Then GoTo 1200
If b(a(120)) = 0 Then b(a(120)) = a(120): c(120) = a(120) Else GoTo 1200
a(106) = 2 * s1 / 15 - a(120):
If b1(a(106)) = 0 Then GoTo 1060
If b(a(106)) = 0 Then b(a(106)) = a(106): c(106) = a(106) Else GoTo 1060
GoSub 2500: If fl1 = 0 Then GoTo 5 'Back Check Identical Numbers
n9 = n9 + 1: GoSub 2650 'Print Square
'' n9 = n9 + 1: Cells(1, 1).Value = n9 'Counting
Erase b, c: GoTo 500 'Print only one square
'' Erase b, c: GoTo 2250 'Print only one square for j225
5
b(c(106)) = 0: c(106) = 0
1060 b(c(120)) = 0: c(120) = 0
1200 b(c(91)) = 0: c(91) = 0
910 b(c(105)) = 0: c(105) = 0
1050 b(c(121)) = 0: c(121) = 0
1210 b(c(135)) = 0: c(135) = 0
1350 Next j135
b(c(76)) = 0: c(76) = 0
760 b(c(90)) = 0: c(90) = 0
900 b(c(136)) = 0: c(136) = 0
1360 b(c(150)) = 0: c(150) = 0
1500 Next j150
b(c(61)) = 0: c(61) = 0
610 b(c(75)) = 0: c(75) = 0
750 b(c(151)) = 0: c(151) = 0
1510 b(c(165)) = 0: c(165) = 0
1650 Next j165
b(c(46)) = 0: c(46) = 0
460 b(c(60)) = 0: c(60) = 0
600 b(c(166)) = 0: c(166) = 0
1660 b(c(180)) = 0: c(180) = 0
1800 Next j180
b(c(31)) = 0: c(31) = 0
310 b(c(45)) = 0: c(45) = 0
450 b(c(181)) = 0: c(181) = 0
1810 b(c(195)) = 0: c(195) = 0
1950 Next j195
b(c(16)) = 0: c(16) = 0
160 b(c(30)) = 0: c(30) = 0
300 b(c(196)) = 0: c(196) = 0
1960 b(c(210)) = 0: c(210) = 0
2100 Next j210
b(c(8)) = 0: c(8) = 0
80 b(c(15)) = 0: c(15) = 0
150 b(c(211)) = 0: c(211) = 0
2110 b(c(218)) = 0: c(218) = 0
2180 Next j218
b(c(7)) = 0: c(7) = 0
70 b(c(9)) = 0: c(9) = 0
90 b(c(217)) = 0: c(217) = 0
2170 b(c(219)) = 0: c(219) = 0
2190 Next j219
b(c(6)) = 0: c(6) = 0
60 b(c(10)) = 0: c(10) = 0
100 b(c(216)) = 0: c(216) = 0
2160 b(c(220)) = 0: c(220) = 0
2200 Next j220
b(c(5)) = 0: c(5) = 0
50 b(c(11)) = 0: c(11) = 0
110 b(c(215)) = 0: c(215) = 0
2150 b(c(221)) = 0: c(221) = 0
2210 Next j221
b(c(4)) = 0: c(4) = 0
40 b(c(12)) = 0: c(12) = 0
120 b(c(214)) = 0: c(214) = 0
2140 b(c(222)) = 0: c(222) = 0
2220 Next j222
b(c(3)) = 0: c(3) = 0
30 b(c(13)) = 0: c(13) = 0
130 b(c(213)) = 0: c(213) = 0
2130 b(c(223)) = 0: c(223) = 0
2230 Next j223
b(c(2)) = 0: c(2) = 0
20 b(c(14)) = 0: c(14) = 0
140 b(c(212)) = 0: c(212) = 0
2120 b(c(224)) = 0: c(224) = 0
2240 Next j224
b(c(1)) = 0: c(1) = 0
10 b(c(225)) = 0: c(225) = 0
2250 Next j225
500
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine MgcSqr15k1")
End
' Exclude solutions with identical numbers
2500 fl1 = 1
For i10 = 1 To 225
c2 = a(i10): If c2 = 0 Then GoTo 2510
For i20 = (1 + i10) To 225
If c2 = a(i20) Then fl1 = 0: Return
Next i20
2510 Next i10
Return
' Print results (lines)
2640
For i1 = 1 To 225
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 226).Value = s1
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 3 Then
n2 = 1: k1 = k1 + 16: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 16
End If
Cells(2, 1).Value = n9
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = j100
i3 = 0
For i1 = 1 To 15
For i2 = 1 To 15
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
End Sub
