' Generates Diamond Inlays of order 7 for Prime Numbers
' Suitable for Concentric Magic Squares of order 13
' Tested with Office 365 under Windows 10
Sub Diamond7()
Dim a1(2448), a(169), b1(43300), b(43300), c(169)
y = MsgBox("Locked", vbCritical, "Routine Diamond7")
End
Sheets("Klad1").Select
n5 = 0: n9 = 0: k1 = 1: k2 = 1
Sheets("Klad1").Select
t1 = Timer
For j1001 = 979 To 979 'Preselection
Cells(2, 1).Value = j1001
j1000 = j1001 ''Sheets("Check13").Cells(j1001, 4).Value
' Define variables
p2 = Sheets("Pairs7").Cells(j1000, 1).Value 'Pair Sum
s1 = 13 * p2 / 2
s7 = 7 * p2 / 2
nVar1 = Sheets("Pairs7").Cells(j1000, 9).Value
If nVar1 < 317 Then GoTo 10010
For i1 = 1 To nVar1
a1(i1) = Sheets("Pairs7").Cells(j1000, 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
' Generate Squares
t11 = Timer 'Time Out
a(85) = p2 / 2: b(a(85)) = a(85)
For j163 = m1 To m2 / 2
If b(a1(j163)) = 0 Then b(a1(j163)) = a1(j163): c(163) = a1(j163) Else GoTo 1630
a(163) = a1(j163)
a(7) = p2 - a(163): If b(a(7)) = 0 Then b(a(7)) = a(7): c(7) = a(7) Else GoTo 70
For j151 = m2 To m1 Step -1
If b(a1(j151)) = 0 Then b(a1(j151)) = a1(j151): c(151) = a1(j151) Else GoTo 1510
a(151) = a1(j151)
a(21) = p2 - a(151): If b(a(21)) = 0 Then b(a(21)) = a(21): c(21) = a(21) Else GoTo 210
For j150 = m2 To m1 Step -1
If b(a1(j150)) = 0 Then b(a1(j150)) = a1(j150): c(150) = a1(j150) Else GoTo 1500
a(150) = a1(j150)
a(20) = p2 - a(150): If b(a(20)) = 0 Then b(a(20)) = a(20): c(20) = a(20) Else GoTo 200
For j149 = m2 / 2 To m2
If b(a1(j149)) = 0 Then b(a1(j149)) = a1(j149): c(149) = a1(j149) Else GoTo 1490
a(149) = a1(j149)
a(19) = p2 - a(149): If b(a(19)) = 0 Then b(a(19)) = a(19): c(19) = a(19) Else GoTo 190
For j139 = m2 To m1 Step -1
If b(a1(j139)) = 0 Then b(a1(j139)) = a1(j139): c(139) = a1(j139) Else GoTo 1390
a(139) = a1(j139)
a(35) = p2 - a(139): If b(a(35)) = 0 Then b(a(35)) = a(35): c(35) = a(35) Else GoTo 350
For j138 = m1 To m2
If b(a1(j138)) = 0 Then b(a1(j138)) = a1(j138): c(138) = a1(j138) Else GoTo 1380
a(138) = a1(j138)
a(34) = p2 - a(138): If b(a(34)) = 0 Then b(a(34)) = a(34): c(34) = a(34) Else GoTo 340
For j137 = m2 / 2 To m2
If b(a1(j137)) = 0 Then b(a1(j137)) = a1(j137): c(137) = a1(j137) Else GoTo 1370
a(137) = a1(j137)
a(33) = p2 - a(137): If b(a(33)) = 0 Then b(a(33)) = a(33): c(33) = a(33) Else GoTo 330
For j136 = m1 To m2
If b(a1(j136)) = 0 Then b(a1(j136)) = a1(j136): c(136) = a1(j136) Else GoTo 1360
a(136) = a1(j136)
a(32) = p2 - a(136): If b(a(32)) = 0 Then b(a(32)) = a(32): c(32) = a(32) Else GoTo 320
For j135 = m2 To m1 Step -1
If b(a1(j135)) = 0 Then b(a1(j135)) = a1(j135): c(135) = a1(j135) Else GoTo 1350
a(135) = a1(j135)
a(31) = p2 - a(135): If b(a(31)) = 0 Then b(a(31)) = a(31): c(31) = a(31) Else GoTo 310
For j127 = m2 To m1 Step -1
If b(a1(j127)) = 0 Then b(a1(j127)) = a1(j127): c(127) = a1(j127) Else GoTo 1270
a(127) = a1(j127)
a(43) = p2 - a(127): If b(a(43)) = 0 Then b(a(43)) = a(43): c(43) = a(43) Else GoTo 430
a(121) = 8 * s1 / 13 - a(127) - a(135) - a(139) - a(149) - a(151) - 2 * a(163)
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(49) = p2 - a(121): If b(a(49)) = 0 Then b(a(49)) = a(49): c(49) = a(49) Else GoTo 490
For j126 = m1 To m2
If b(a1(j126)) = 0 Then b(a1(j126)) = a1(j126): c(126) = a1(j126) Else GoTo 1260
a(126) = a1(j126)
a(48) = p2 - a(126): If b(a(48)) = 0 Then b(a(48)) = a(48): c(48) = a(48) Else GoTo 480
For j125 = m1 To m2
If b(a1(j125)) = 0 Then b(a1(j125)) = a1(j125): c(125) = a1(j125) Else GoTo 1250
a(125) = a1(j125)
a(47) = p2 - a(125): If b(a(47)) = 0 Then b(a(47)) = a(47): c(47) = a(47) Else GoTo 470
For j124 = m1 To m2
If b(a1(j124)) = 0 Then b(a1(j124)) = a1(j124): c(124) = a1(j124) Else GoTo 1240
a(124) = a1(j124)
a(46) = p2 - a(124): If b(a(46)) = 0 Then b(a(46)) = a(46): c(46) = a(46) Else GoTo 460
For j123 = m1 To m2
If b(a1(j123)) = 0 Then b(a1(j123)) = a1(j123): c(123) = a1(j123) Else GoTo 1230
a(123) = a1(j123)
a(45) = p2 - a(123): If b(a(45)) = 0 Then b(a(45)) = a(45): c(45) = a(45) Else GoTo 450
a(122) = -s1 / 13 - a(123) - a(124) - a(125) - a(126) + a(135) + a(139) + a(149) + a(151) + 2 * a(163)
If a(122) < a1(m1) Or a(122) > a1(m2) Then GoTo 1220:
If b1(a(122)) = 0 Then GoTo 1220
If b(a(122)) = 0 Then b(a(122)) = a(122): c(122) = a(122) Else GoTo 1220
a(44) = p2 - a(122): If b(a(44)) = 0 Then b(a(44)) = a(44): c(44) = a(44) Else GoTo 440
For j115 = m2 To m1 Step -1
If b(a1(j115)) = 0 Then b(a1(j115)) = a1(j115): c(115) = a1(j115) Else GoTo 1150
a(115) = a1(j115)
a(107) = p2 - a(115): If b(a(107)) = 0 Then b(a(107)) = a(107): c(107) = a(107) Else GoTo 1070
For j114 = m1 To m2
If b(a1(j114)) = 0 Then b(a1(j114)) = a1(j114): c(114) = a1(j114) Else GoTo 1140
a(114) = a1(j114)
a(108) = p2 - a(114): If b(a(108)) = 0 Then b(a(108)) = a(108): c(108) = a(108) Else GoTo 1080
For j113 = m1 To m2
If b(a1(j113)) = 0 Then b(a1(j113)) = a1(j113): c(113) = a1(j113) Else GoTo 1130
a(113) = a1(j113)
a(57) = p2 - a(113): If b(a(57)) = 0 Then b(a(57)) = a(57): c(57) = a(57) Else GoTo 570
a(109) = 8 * s1 / 13 - a(113) - a(123) - a(125) - 2 * a(137) - a(149) - a(151)
If a(109) < a1(m1) Or a(109) > a1(m2) Then GoTo 1090:
If b1(a(109)) = 0 Then GoTo 1090
If b(a(109)) = 0 Then b(a(109)) = a(109): c(109) = a(109) Else GoTo 1090
a(61) = p2 - a(109): If b(a(61)) = 0 Then b(a(61)) = a(61): c(61) = a(61) Else GoTo 610
For j112 = m1 To m2
If b(a1(j112)) = 0 Then b(a1(j112)) = a1(j112): c(112) = a1(j112) Else GoTo 1120
a(112) = a1(j112)
a(60) = p2 - a(112): If b(a(60)) = 0 Then b(a(60)) = a(60): c(60) = a(60) Else GoTo 600
For j111 = m1 To m2
If b(a1(j111)) = 0 Then b(a1(j111)) = a1(j111): c(111) = a1(j111) Else GoTo 1110
a(111) = a1(j111)
a(59) = p2 - a(111): If b(a(59)) = 0 Then b(a(59)) = a(59): c(59) = a(59) Else GoTo 590
a(110) = -3 * s1 / 13 - a(111) - a(112) + a(123) + a(125) + 2 * a(137) + a(149) + a(151)
If a(110) < a1(m1) Or a(110) > a1(m2) Then GoTo 1100:
If b1(a(110)) = 0 Then GoTo 1100
If b(a(110)) = 0 Then b(a(110)) = a(110): c(110) = a(110) Else GoTo 1100
a(58) = p2 - a(110): If b(a(58)) = 0 Then b(a(58)) = a(58): c(58) = a(58) Else GoTo 580
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Erase b1, b, c: GoTo 10010 'Time Out, Try Next j1001
''If t13 > 30 Then Erase b, c: t11 = Timer: GoTo 1630 'Time Out, Try Next j163
a(98) = 3 * s1 / 13 - a(109) + 2 * a(111) - a(113) + a(135) - 2 * a(137) + a(139) - a(149) - a(151)
If a(98) < a1(m1) Or a(98) > a1(m2) Then GoTo 980:
If b1(a(98)) = 0 Then GoTo 980
If b(a(98)) = 0 Then b(a(98)) = a(98): c(98) = a(98) Else GoTo 980
a(72) = p2 - a(98): If b(a(72)) = 0 Then b(a(72)) = a(72): c(72) = a(72) Else GoTo 720
For j103 = m1 To m2
If b(a1(j103)) = 0 Then b(a1(j103)) = a1(j103): c(103) = a1(j103) Else GoTo 1030
a(103) = a1(j103)
a(93) = p2 - a(103): If b(a(93)) = 0 Then b(a(93)) = a(93): c(93) = a(93) Else GoTo 930
a(91) = 7 * s1 / 13 - a(103) - a(115) - a(127) - a(139) - a(151) - a(163)
If a(91) < a1(m1) Or a(91) > a1(m2) Then GoTo 910:
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(79) = p2 - a(91): If b(a(79)) = 0 Then b(a(79)) = a(79): c(79) = a(79) Else GoTo 790
For j102 = m1 To m2
If b(a1(j102)) = 0 Then b(a1(j102)) = a1(j102): c(102) = a1(j102) Else GoTo 1020
a(102) = a1(j102)
a(94) = p2 - a(102): If b(a(94)) = 0 Then b(a(94)) = a(94): c(94) = a(94) Else GoTo 940
For j101 = m1 To m2
If b(a1(j101)) = 0 Then b(a1(j101)) = a1(j101): c(101) = a1(j101) Else GoTo 1010
a(101) = a1(j101)
a(95) = p2 - a(101): If b(a(95)) = 0 Then b(a(95)) = a(95): c(95) = a(95) Else GoTo 950
For j100 = m1 To m2
If b(a1(j100)) = 0 Then b(a1(j100)) = a1(j100): c(100) = a1(j100) Else GoTo 1000
a(100) = a1(j100)
a(96) = p2 - a(100): If b(a(96)) = 0 Then b(a(96)) = a(96): c(96) = a(96) Else GoTo 960
For j99 = m1 To m2
If b(a1(j99)) = 0 Then b(a1(j99)) = a1(j99): c(99) = a1(j99) Else GoTo 990
a(99) = a1(j99)
a(71) = p2 - a(99): If b(a(71)) = 0 Then b(a(71)) = a(71): c(71) = a(71) Else GoTo 710
a(97) = 8 * s1 / 13 - a(99) - 2 * a(111) - a(123) - a(125) - a(135) - a(139)
If a(97) < a1(m1) Or a(97) > a1(m2) Then GoTo 970:
If b1(a(97)) = 0 Then GoTo 970
If b(a(97)) = 0 Then b(a(97)) = a(97): c(97) = a(97) Else GoTo 970
a(73) = p2 - a(97): If b(a(73)) = 0 Then b(a(73)) = a(73): c(73) = a(73) Else GoTo 730
a(87) = 15 * s1/13-a(99)-a(101)-a(111)-a(115)-a(121)-a(125)-a(127)-a(135)-2*a(139)-a(149)-a(151)- 2 * a(163)
If a(87) < a1(m1) Or a(87) > a1(m2) Then GoTo 870:
If b1(a(87)) = 0 Then GoTo 870
If b(a(87)) = 0 Then b(a(87)) = a(87): c(87) = a(87) Else GoTo 870
a(83) = p2 - a(87): If b(a(83)) = 0 Then b(a(83)) = a(83): c(83) = a(83) Else GoTo 830
a(86) = 9 * s1 / 13 - 2 * a(99) - 2 * a(111) - a(123) - a(125) - a(135) - a(139)
If a(86) < a1(m1) Or a(86) > a1(m2) Then GoTo 860:
If b1(a(86)) = 0 Then GoTo 860
If b(a(86)) = 0 Then b(a(86)) = a(86): c(86) = a(86) Else GoTo 860
a(84) = p2 - a(86): If b(a(84)) = 0 Then b(a(84)) = a(84): c(84) = a(84) Else GoTo 840
a(74) = 4 * s1/13+a(99)-a(100)+a(101)+a(111)-2*a(113)+a(115)-a(123) -2*a(137)+a(139)-a(149)-a(151)
If a(74) < a1(m1) Or a(74) > a1(m2) Then GoTo 740:
If b1(a(74)) = 0 Then GoTo 740
If b(a(74)) = 0 Then b(a(74)) = a(74): c(74) = a(74) Else GoTo 740
a(70) = p2 - a(74): If b(a(70)) = 0 Then b(a(70)) = a(70): c(70) = a(70) Else GoTo 700
For j90 = m1 To m2
If b(a1(j90)) = 0 Then b(a1(j90)) = a1(j90): c(90) = a1(j90) Else GoTo 900
a(90) = a1(j90)
a(80) = p2 - a(90): If b(a(80)) = 0 Then b(a(80)) = a(80): c(80) = a(80) Else GoTo 800
For j89 = m1 To m2
If b(a1(j89)) = 0 Then b(a1(j89)) = a1(j89): c(89) = a1(j89) Else GoTo 890
a(89) = a1(j89)
a(81) = p2 - a(89): If b(a(81)) = 0 Then b(a(81)) = a(81): c(81) = a(81) Else GoTo 810
a(77) = 7 * s1 / 13 - a(89) - a(101) - a(113) - a(125) - a(137) - a(149)
If a(77) < a1(m1) Or a(77) > a1(m2) Then GoTo 770:
If b1(a(77)) = 0 Then GoTo 770
If b(a(77)) = 0 Then b(a(77)) = a(77): c(77) = a(77) Else GoTo 770
a(67) = p2 - a(77): If b(a(67)) = 0 Then b(a(67)) = a(67): c(67) = a(67) Else GoTo 670
a(75) = 7 * s1 / 13 - a(89) - a(103) - a(113) - a(123) - a(137) - a(151)
If a(75) < a1(m1) Or a(75) > a1(m2) Then GoTo 750:
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(69) = p2 - a(75): If b(a(69)) = 0 Then b(a(69)) = a(69): c(69) = a(69) Else GoTo 690
a(63) = -8 * s1/13+a(89)+a(101)+a(103)+a(113)+a(115)-a(122)-a(123)-a(124)-a(126)+a(137)+2*a(139)+a(149)+2*a(151)+2*a(163)
If a(63) < a1(m1) Or a(63) > a1(m2) Then GoTo 630:
If b1(a(63)) = 0 Then GoTo 630
If b(a(63)) = 0 Then b(a(63)) = a(63): c(63) = a(63) Else GoTo 630
a(55) = p2 - a(63): If b(a(55)) = 0 Then b(a(55)) = a(55): c(55) = a(55) Else GoTo 550
For j88 = m1 To m2
If b(a1(j88)) = 0 Then b(a1(j88)) = a1(j88): c(88) = a1(j88) Else GoTo 880
a(88) = a1(j88)
a(82) = p2 - a(88): If b(a(82)) = 0 Then b(a(82)) = a(82): c(82) = a(82) Else GoTo 820
a(62) = 12 * s1 / 13 - a(75) - a(88) - a(101) - a(114) - a(122) - a(123) - a(124) - a(125) - a(126) - 2 * a(127)
If a(62) < a1(m1) Or a(62) > a1(m2) Then GoTo 620:
If b1(a(62)) = 0 Then GoTo 620
If b(a(62)) = 0 Then b(a(62)) = a(62): c(62) = a(62) Else GoTo 620
a(56) = p2 - a(62): If b(a(56)) = 0 Then b(a(56)) = a(56): c(56) = a(56) Else GoTo 560
For j76 = m1 To m2
If b(a1(j76)) = 0 Then b(a1(j76)) = a1(j76): c(76) = a1(j76) Else GoTo 760
a(76) = a1(j76)
a(68) = p2 - a(76): If b(a(68)) = 0 Then b(a(68)) = a(68): c(68) = a(68) Else GoTo 680
' Exclude solutions with identical numbers
GoSub 1800: If fl1 = 0 Then GoTo 5
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers)
Erase b, c: GoTo 10010 'Only First Square
5
b(c(68)) = 0: c(68) = 0
680 b(c(76)) = 0: c(76) = 0
760 Next j76
b(c(56)) = 0: c(56) = 0
560 b(c(62)) = 0: c(62) = 0
620 b(c(82)) = 0: c(82) = 0
820 b(c(88)) = 0: c(88) = 0
880 Next j88
b(c(55)) = 0: c(55) = 0
550 b(c(63)) = 0: c(63) = 0
630 b(c(69)) = 0: c(69) = 0
690 b(c(75)) = 0: c(75) = 0
750 b(c(67)) = 0: c(67) = 0
670 b(c(77)) = 0: c(77) = 0
770 b(c(81)) = 0: c(81) = 0
810 b(c(89)) = 0: c(89) = 0
890 Next j89
b(c(80)) = 0: c(80) = 0
800 b(c(90)) = 0: c(90) = 0
900 Next j90
b(c(70)) = 0: c(70) = 0
700 b(c(74)) = 0: c(74) = 0
740 b(c(84)) = 0: c(84) = 0
840 b(c(86)) = 0: c(86) = 0
860 b(c(83)) = 0: c(83) = 0
830 b(c(87)) = 0: c(87) = 0
870 b(c(73)) = 0: c(73) = 0
730 b(c(97)) = 0: c(97) = 0
970 b(c(71)) = 0: c(71) = 0
710 b(c(99)) = 0: c(99) = 0
990 Next j99
b(c(96)) = 0: c(96) = 0
960 b(c(100)) = 0: c(100) = 0
1000 Next j100
b(c(95)) = 0: c(95) = 0
950 b(c(101)) = 0: c(101) = 0
1010 Next j101
b(c(94)) = 0: c(94) = 0
940 b(c(102)) = 0: c(102) = 0
1020 Next j102
b(c(79)) = 0: c(79) = 0
790 b(c(91)) = 0: c(91) = 0
910 b(c(93)) = 0: c(93) = 0
930 b(c(103)) = 0: c(103) = 0
1030 Next j103
b(c(72)) = 0: c(72) = 0
720 b(c(98)) = 0: c(98) = 0
980 b(c(58)) = 0: c(58) = 0
580 b(c(110)) = 0: c(110) = 0
1100 b(c(59)) = 0: c(59) = 0
590 b(c(111)) = 0: c(111) = 0
1110 Next j111
b(c(60)) = 0: c(60) = 0
600 b(c(112)) = 0: c(112) = 0
1120 Next j112
b(c(61)) = 0: c(61) = 0
610 b(c(109)) = 0: c(109) = 0
1090 b(c(57)) = 0: c(57) = 0
570 b(c(113)) = 0: c(113) = 0
1130 Next j113
b(c(108)) = 0: c(108) = 0
1080 b(c(114)) = 0: c(114) = 0
1140 Next j114
b(c(107)) = 0: c(107) = 0
1070 b(c(115)) = 0: c(115) = 0
1150 Next j115
b(c(44)) = 0: c(44) = 0
440 b(c(122)) = 0: c(122) = 0
1220 b(c(45)) = 0: c(45) = 0
450 b(c(123)) = 0: c(123) = 0
1230 Next j123
b(c(46)) = 0: c(46) = 0
460 b(c(124)) = 0: c(124) = 0
1240 Next j124
b(c(47)) = 0: c(47) = 0
470 b(c(125)) = 0: c(125) = 0
1250 Next j125
b(c(48)) = 0: c(48) = 0
480 b(c(126)) = 0: c(126) = 0
1260 Next j126
b(c(49)) = 0: c(49) = 0
490 b(c(121)) = 0: c(121) = 0
1210 b(c(43)) = 0: c(43) = 0
430 b(c(127)) = 0: c(127) = 0
1270 Next j127
b(c(31)) = 0: c(31) = 0
310 b(c(135)) = 0: c(135) = 0
1350 Next j135
b(c(32)) = 0: c(32) = 0
320 b(c(136)) = 0: c(136) = 0
1360 Next j136
b(c(33)) = 0: c(33) = 0
330 b(c(137)) = 0: c(137) = 0
1370 Next j137
b(c(34)) = 0: c(34) = 0
340 b(c(138)) = 0: c(138) = 0
1380 Next j138
b(c(35)) = 0: c(35) = 0
350 b(c(139)) = 0: c(139) = 0
1390 Next j139
b(c(19)) = 0: c(19) = 0
190 b(c(149)) = 0: c(149) = 0
1490 Next j149
b(c(20)) = 0: c(20) = 0
200 b(c(150)) = 0: c(150) = 0
1500 Next j150
b(c(21)) = 0: c(21) = 0
210 b(c(151)) = 0: c(151) = 0
1510 Next j151
b(c(7)) = 0: c(7) = 0
70 b(c(163)) = 0: c(163) = 0
1630 Next j163
Erase b, c
10010 Next j1001
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
y = MsgBox(t10, 0, "Routine Diamond7")
End
' Double Check Identical Numbers a()
1800 fl1 = 1
For i1 = 1 To 169
a20 = a(i1): If a20 = 0 Then GoTo 1810
For i2 = (1 + i1) To 169
If a20 = a(i2) Then fl1 = 0: Return
Next i2
1810 Next i1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 169
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 170).Value = s7
Cells(n9, 171).Value = j1000
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 2 Then
n2 = 1: k1 = k1 + 14: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 14
End If
Cells(1, 1).Value = n9
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = "s7 = " + CStr(s7)
Sheets("Check13").Cells(j1001, 7).Value = "ok"
i3 = 0
For i1 = 1 To 13
For i2 = 1 To 13
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
End Sub
