' Generates Concentric Lozenge Squares of order 15
' Diamond Inlays order 8
' Tested with Office 365 under Windows 10
Sub MgcSqr15a()
Dim a1(225), a(225), b(225), b1(225), c(225)
y = MsgBox("Locked", vbCritical, "Routine MgcSqr15a")
End
n5 = 0: n9 = 0: n10 = 0: k1 = 1: k2 = 1
Sheets("Klad1").Select
t1 = Timer
m1 = 1: m2 = 112: s1 = 1695: p2 = 226
For i1 = 1 To m2
a1(i1) = 2 * i1: b1(a1(i1)) = a1(i1)
Next i1
For j100 = 2 To 2
' Read Diamond Inlay / Border 13 Combinations
Erase a
For i1 = 1 To 225
a(i1) = Sheets("BrdrLns13").Cells(j100, i1):
If a(i1) <> 0 Then b(a(i1)) = a(i1)
Next i1
' Complete Border (only even numbers available)
For j225 = m2 To m1 Step -1 'a(225)
If b(a1(j225)) = 0 Then b(a1(j225)) = a1(j225): c(225) = a1(j225) Else GoTo 2250
a(225) = a1(j225)
a(1) = p2 - a(225): If b(a(1)) = 0 Then b(a(1)) = a(1): c(1) = a(1) Else GoTo 12
For j224 = j225 - 1 To m1 Step -1 '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(14) = p2 - a(224): If b(a(14)) = 0 Then b(a(14)) = a(14): c(14) = a(14) Else GoTo 140
For j223 = j224 - 1 To m1 Step -1 '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(13) = p2 - a(223): If b(a(13)) = 0 Then b(a(13)) = a(13): c(13) = a(13) Else GoTo 130
For j222 = j223 - 1 To m1 Step -1 '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(12) = p2 - a(222): If b(a(12)) = 0 Then b(a(12)) = a(12): c(12) = a(12) Else GoTo 120
For j221 = j222 - 1 To m1 Step -1 'a(221)
If b(a1(j221)) = 0 Then b(a1(j221)) = a1(j221): c(221) = a1(j221) Else GoTo 2212
a(221) = a1(j221)
a(11) = p2 - a(221): If b(a(11)) = 0 Then b(a(11)) = a(11): c(11) = a(11) Else GoTo 110
For j220 = j221 - 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(10) = p2 - a(220): If b(a(10)) = 0 Then b(a(10)) = a(10): c(10) = a(10) Else GoTo 100
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(9) = p2 - a(219): If b(a(9)) = 0 Then b(a(9)) = a(9): c(9) = a(9) Else GoTo 90
For j217 = m1 To m2 'a(217)
If b(a1(j217)) = 0 Then b(a1(j217)) = a1(j217): c(217) = a1(j217) Else GoTo 2170
a(217) = a1(j217)
a(7) = p2 - a(217): If b(a(7)) = 0 Then b(a(7)) = a(7): c(7) = a(7) Else GoTo 70
For j216 = j217 + 1 To m2 'a(216)
If b(a1(j216)) = 0 Then b(a1(j216)) = a1(j216): c(216) = a1(j216) Else GoTo 2160
a(216) = a1(j216)
a(6) = p2 - a(216): If b(a(6)) = 0 Then b(a(6)) = a(6): c(6) = a(6) Else GoTo 60
For j215 = m1 To m2 'a(215)
If b(a1(j215)) = 0 Then b(a1(j215)) = a1(j215): c(215) = a1(j215) Else GoTo 2150
a(215) = a1(j215)
a(5) = p2 - a(215): If b(a(5)) = 0 Then b(a(5)) = a(5): c(5) = a(5) Else GoTo 50
For j214 = m1 To m2 'a(214)
If b(a1(j214)) = 0 Then b(a1(j214)) = a1(j214): c(214) = a1(j214) Else GoTo 2140
a(214) = a1(j214)
a(4) = p2 - a(214): If b(a(4)) = 0 Then b(a(4)) = a(4): c(4) = a(4) Else GoTo 40
For j213 = m1 To m2 'a(213)
If b(a1(j213)) = 0 Then b(a1(j213)) = a1(j213): c(213) = a1(j213) Else GoTo 2130
a(213) = a1(j213)
a(3) = p2 - a(213): If b(a(3)) = 0 Then b(a(3)) = a(3): c(3) = a(3) Else GoTo 30
For j212 = m1 To m2 'a(212)
If b(a1(j212)) = 0 Then b(a1(j212)) = a1(j212): c(212) = a1(j212) Else GoTo 2120
a(212) = a1(j212)
a(2) = p2 - a(212): If b(a(2)) = 0 Then b(a(2)) = a(2): c(2) = a(2) Else GoTo 20
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) = p2 - a(211): If b(a(15)) = 0 Then b(a(15)) = a(15): c(15) = a(15) Else GoTo 150
For j210 = m2 To m1 Step -1 '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) = p2 - a(210): If b(a(196)) = 0 Then b(a(196)) = a(196): c(196) = a(196) Else GoTo 1960
For j195 = j210 - 1 To m1 Step -1 '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) = p2 - a(195): If b(a(181)) = 0 Then b(a(181)) = a(181): c(181) = a(181) Else GoTo 1810
For j180 = j195 - 1 To m1 Step -1 '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) = p2 - a(180): If b(a(166)) = 0 Then b(a(166)) = a(166): c(166) = a(166) Else GoTo 1660
For j165 = j180 - 1 To m1 Step -1 '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) = p2 - a(165): If b(a(151)) = 0 Then b(a(151)) = a(151): c(151) = a(151) Else GoTo 1510
For j150 = j165 - 1 To m1 Step -1 '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) = p2 - a(150): If b(a(136)) = 0 Then b(a(136)) = a(136): c(136) = a(136) Else GoTo 1360
For j135 = j150 - 1 To m1 Step -1 '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) = p2 - a(135): If b(a(121)) = 0 Then b(a(121)) = a(121): c(121) = a(121) Else GoTo 1210
For j105 = m1 To m2 'a(105)
If b(a1(j105)) = 0 Then b(a1(j105)) = a1(j105): c(105) = a1(j105) Else GoTo 1050
a(105) = a1(j105)
a(91) = p2 - a(105): If b(a(91)) = 0 Then b(a(91)) = a(91): c(91) = a(91) Else GoTo 910
For j90 = j105 + 1 To m2 'a(90)
If b(a1(j90)) = 0 Then b(a1(j90)) = a1(j90): c(90) = a1(j90) Else GoTo 900
a(90) = a1(j90)
a(76) = p2 - a(90): If b(a(76)) = 0 Then b(a(76)) = a(76): c(76) = a(76) Else GoTo 760
For j75 = j90 + 1 To m2 'a(75)
If b(a1(j75)) = 0 Then b(a1(j75)) = a1(j75): c(75) = a1(j75) Else GoTo 750
a(75) = a1(j75)
a(61) = p2 - a(75): If b(a(61)) = 0 Then b(a(61)) = a(61): c(61) = a(61) Else GoTo 610
For j60 = j75 + 1 To m2 'a(60)
If b(a1(j60)) = 0 Then b(a1(j60)) = a1(j60): c(60) = a1(j60) Else GoTo 600
a(60) = a1(j60)
a(46) = p2 - a(60): If b(a(46)) = 0 Then b(a(46)) = a(46): c(46) = a(46) Else GoTo 460
For j45 = j60 + 1 To m2 'a(45)
If b(a1(j45)) = 0 Then b(a1(j45)) = a1(j45): c(45) = a1(j45) Else GoTo 450
a(45) = a1(j45)
a(31) = p2 - a(45): If b(a(31)) = 0 Then b(a(31)) = a(31): c(31) = a(31) Else GoTo 310
a(30) = s1 - a(15)-a(45)-a(60)-a(75)-a(90)-a(105)-a(120)-a(135)-a(150)-a(165)-a(180)-a(195)-a(210)-a(225)
If a(30) < a1(m1) Or a(30) > a1(m2) Then GoTo 300
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) = p2 - a(30): If b(a(16)) = 0 Then b(a(16)) = a(16): c(16) = a(16) Else GoTo 160
' Exclude solutions with identical numbers
GoSub 2800: If fl1 = 0 Then GoTo 5
n9 = n9 + 1
GoSub 2650 'Print Result (Squares)
Erase b, c: GoTo 3000 'Print only first square
5
b(c(16)) = 0: c(16) = 0
160 b(c(30)) = 0: c(30) = 0
300 b(c(31)) = 0: c(31) = 0
310 b(c(45)) = 0: c(45) = 0
450 Next j45
b(c(46)) = 0: c(46) = 0
460 b(c(60)) = 0: c(60) = 0
600 Next j60
b(c(61)) = 0: c(61) = 0
610 b(c(75)) = 0: c(75) = 0
750 Next j75
b(c(76)) = 0: c(76) = 0
760 b(c(90)) = 0: c(90) = 0
900 Next j90
b(c(91)) = 0: c(91) = 0
910 b(c(105)) = 0: c(105) = 0
1050 Next j105
b(c(121)) = 0: c(121) = 0
1210 b(c(135)) = 0: c(135) = 0
1350 Next j135
b(c(136)) = 0: c(136) = 0
1360 b(c(150)) = 0: c(150) = 0
1500 Next j150
b(c(151)) = 0: c(151) = 0
1510 b(c(165)) = 0: c(165) = 0
1650 Next j165
b(c(166)) = 0: c(166) = 0
1660 b(c(180)) = 0: c(180) = 0
1800 Next j180
b(c(181)) = 0: c(181) = 0
1810 b(c(195)) = 0: c(195) = 0
1950 Next j195
b(c(196)) = 0: c(196) = 0
1960 b(c(210)) = 0: c(210) = 0
2100 Next j210
b(c(15)) = 0: c(15) = 0
150 b(c(211)) = 0: c(211) = 0
2110 b(c(2)) = 0: c(2) = 0
20 b(c(212)) = 0: c(212) = 0
2120 Next j212
b(c(3)) = 0: c(3) = 0
30 b(c(213)) = 0: c(213) = 0
2130 Next j213
b(c(4)) = 0: c(4) = 0
40 b(c(214)) = 0: c(214) = 0
2140 Next j214
b(c(5)) = 0: c(5) = 0
50 b(c(215)) = 0: c(215) = 0
2150 Next j215
b(c(6)) = 0: c(6) = 0
60 b(c(216)) = 0: c(216) = 0
2160 Next j216
b(c(7)) = 0: c(7) = 0
70 b(c(217)) = 0: c(217) = 0
2170 Next j217
b(c(9)) = 0: c(9) = 0
90 b(c(219)) = 0: c(219) = 0
2190 Next j219
b(c(10)) = 0: c(10) = 0
100 b(c(220)) = 0: c(220) = 0
2200 Next j220
b(c(11)) = 0: c(11) = 0
110 b(c(221)) = 0: c(221) = 0
2212 Next j221
b(c(12)) = 0: c(12) = 0
120 b(c(222)) = 0: c(222) = 0
2220 Next j222
b(c(13)) = 0: c(13) = 0
130 b(c(223)) = 0: c(223) = 0
2230 Next j223
b(c(14)) = 0: c(14) = 0
140 b(c(224)) = 0: c(224) = 0
2240 Next j224
b(c(1)) = 0: c(1) = 0
12 b(c(225)) = 0: c(225) = 0
2250 Next j225
n10 = 0: Erase b, c
3000 Next j100
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine MgcSqr15a")
End
' Print results (selected numbers)
2645 For i1 = 1 To 225
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 226).Value = n9
Return
' Print results (squares)
2650 n5 = n5 + 1
If n5 = 3 Then
n5 = 1: k1 = k1 + 16: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 16
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
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
' Exclude solutions with identical numbers
2800 fl1 = 1
For j1 = 1 To 225
a2 = a(j1): If a2 = 0 Then GoTo 2810
For j2 = (1 + j1) To 225
If a2 = a(j2) Then fl1 = 0: Return
Next j2
2810 Next j1
Return
End Sub
