' Order 10 Inlaid Magic Squares: Integers 1 ... 100
' Border for Order 7 Inlays
' Tested with Office 365 under Windows 10
Sub MgcSqr0214()
Dim a1(100), a(100), b1(100), b(100), c(100)
y = MsgBox("Locked", vbCritical, "Routine MgcSqr0214")
End
n2 = 0: n3 = 0: n9 = 0: n10 = 0: k1 = 1: k2 = 1
ShtNm1 = "Input10":
Sheets("Klad1").Select
' Full Range
s1 = 505: s7 = 350
s3 = s1 - s7
Erase b1:
For i1 = 1 To 100
b1(i1) = i1
Next i1
pMin = 1: pMax = 100
' Read Predefined Inlaid Square (If Applicable)
i3 = 0
For i1 = 1 To 10
For i2 = 1 To 10
i3 = i3 + 1
a(i3) = Sheets(ShtNm1).Cells(i1 + 1, i2 + 1).Value
b1(a(i3)) = 0
Next i2
Next i1
i2 = 0
For i1 = pMin To pMax
If b1(i1) <> 0 Then
i2 = i2 + 1: a1(i2) = i1
End If
Next i1
m1 = 1: m2 = i2
t1 = Timer
' Block here (If Applicable)
' Diagonal
For j100 = m2 To m1 Step -1
If b(a1(j100)) = 0 Then b(a1(j100)) = a1(j100): c(100) = a1(j100) Else GoTo 1000
a(100) = a1(j100)
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(78) = s3 - a(100) - a(89)
If a(78) < a1(m1) Or a(78) > a1(m2) Then GoTo 780:
If b1(a(78)) = 0 Then GoTo 780
If b(a(78)) = 0 Then b(a(78)) = a(78): c(78) = a(78) Else GoTo 780
' Column 10
For j10 = m1 To m2 ''m1 To m2
If b(a1(j10)) = 0 Then b(a1(j10)) = a1(j10): c(10) = a1(j10) Else GoTo 100
a(10) = a1(j10)
' Row 1
For j9 = m1 To m2
If b(a1(j9)) = 0 Then b(a1(j9)) = a1(j9): c(9) = a1(j9) Else GoTo 90
a(9) = a1(j9)
a(8) = s3 - a(10) - a(9)
If a(8) < a1(m1) Or a(8) > a1(m2) Then GoTo 80:
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
For j20 = m2 To m1 Step -1
If b(a1(j20)) = 0 Then b(a1(j20)) = a1(j20): c(20) = a1(j20) Else GoTo 200
a(20) = a1(j20)
' ROw 2
For j19 = m2 To m1 Step -1
If b(a1(j19)) = 0 Then b(a1(j19)) = a1(j19): c(19) = a1(j19) Else GoTo 190
a(19) = a1(j19)
a(18) = s3 - a(20) - a(19)
If a(18) < a1(m1) Or a(18) > a1(m2) Then GoTo 180:
If b1(a(18)) = 0 Then GoTo 180
If b(a(18)) = 0 Then b(a(18)) = a(18): c(18) = a(18) Else GoTo 180
For j30 = j20 + 1 To m2
If b(a1(j30)) = 0 Then b(a1(j30)) = a1(j30): c(30) = a1(j30) Else GoTo 300
a(30) = a1(j30)
' Row 3
For j29 = m1 To m2
If b(a1(j29)) = 0 Then b(a1(j29)) = a1(j29): c(29) = a1(j29) Else GoTo 290
a(29) = a1(j29)
a(28) = s3 - a(30) - a(29)
If a(28) < a1(m1) Or a(28) > a1(m2) Then GoTo 280:
If b1(a(28)) = 0 Then GoTo 280
If b(a(28)) = 0 Then b(a(28)) = a(28): c(28) = a(28) Else GoTo 280
' Row 4
For j39 = m2 To m1 Step -1
If b(a1(j39)) = 0 Then b(a1(j39)) = a1(j39): c(39) = a1(j39) Else GoTo 390
a(39) = a1(j39)
For j40 = m1 To m2
If b(a1(j40)) = 0 Then b(a1(j40)) = a1(j40): c(40) = a1(j40) Else GoTo 400
a(40) = a1(j40)
a(38) = s3 - a(40) - a(39)
If a(38) < a1(m1) Or a(38) > a1(m2) Then GoTo 380:
If b1(a(38)) = 0 Then GoTo 380
If b(a(38)) = 0 Then b(a(38)) = a(38): c(38) = a(38) Else GoTo 380
For j50 = j40 + 1 To m2
If b(a1(j50)) = 0 Then b(a1(j50)) = a1(j50): c(50) = a1(j50) Else GoTo 500
a(50) = a1(j50)
' Row 5
For j49 = m1 To m2
If b(a1(j49)) = 0 Then b(a1(j49)) = a1(j49): c(49) = a1(j49) Else GoTo 490
a(49) = a1(j49)
a(48) = s3 - a(50) - a(49)
If a(48) < a1(m1) Or a(48) > a1(m2) Then GoTo 480:
If b1(a(48)) = 0 Then GoTo 480
If b(a(48)) = 0 Then b(a(48)) = a(48): c(48) = a(48) Else GoTo 480
For j60 = m2 To m1 Step -1
If b(a1(j60)) = 0 Then b(a1(j60)) = a1(j60): c(60) = a1(j60) Else GoTo 600
a(60) = a1(j60)
' Row 6
For j59 = m1 To m2
If b(a1(j59)) = 0 Then b(a1(j59)) = a1(j59): c(59) = a1(j59) Else GoTo 590
a(59) = a1(j59)
a(58) = s3 - a(60) - a(59)
If a(58) < a1(m1) Or a(58) > a1(m2) Then GoTo 580:
If b1(a(58)) = 0 Then GoTo 580
If b(a(58)) = 0 Then b(a(58)) = a(58): c(58) = a(58) Else GoTo 580
For j70 = m2 To m1 Step -1
If b(a1(j70)) = 0 Then b(a1(j70)) = a1(j70): c(70) = a1(j70) Else GoTo 700
a(70) = a1(j70)
' Row 7
For j69 = m2 To m1 Step -1
If b(a1(j69)) = 0 Then b(a1(j69)) = a1(j69): c(69) = a1(j69) Else GoTo 690
a(69) = a1(j69)
a(68) = s3 - a(70) - a(69)
If a(68) < a1(m1) Or a(68) > a1(m2) Then GoTo 680:
If b1(a(68)) = 0 Then GoTo 680
If b(a(68)) = 0 Then b(a(68)) = a(68): c(68) = a(68) Else GoTo 680
For j79 = m1 To m2
If b(a1(j79)) = 0 Then b(a1(j79)) = a1(j79): c(79) = a1(j79) Else GoTo 790
a(79) = a1(j79)
a(99) = s1 - a(9) - a(19) - a(29) - a(39) - a(49) - a(59) - a(69) - a(79) - a(89)
If a(99) < a1(m1) Or a(99) > a1(m2) Then GoTo 990:
If b1(a(99)) = 0 Then GoTo 990
If b(a(99)) = 0 Then b(a(99)) = a(99): c(99) = a(99) Else GoTo 990
For j80 = m1 To m2
If b(a1(j80)) = 0 Then b(a1(j80)) = a1(j80): c(80) = a1(j80) Else GoTo 800
a(80) = a1(j80)
a(90) = s1 - a(100) - a(80) - a(70) - a(60) - a(50) - a(40) - a(30) - a(20) - a(10)
If a(90) < a1(m1) Or a(90) > a1(m2) Then GoTo 900:
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
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(98) = s1 - a(8) - a(18) - a(28) - a(38) - a(48) - a(58) - a(68) - a(78) - a(88)
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
For j91 = m1 To m2
If b(a1(j91)) = 0 Then b(a1(j91)) = a1(j91): c(91) = a1(j91) Else GoTo 910
a(91) = a1(j91)
For j81 = m2 To m1 Step -1
If b(a1(j81)) = 0 Then b(a1(j81)) = a1(j81): c(81) = a1(j81) Else GoTo 810
a(81) = a1(j81)
a(71) = s3 - a(81) - a(91)
If a(71) < a1(m1) Or a(71) > a1(m2) Then GoTo 710:
If b1(a(71)) = 0 Then GoTo 710
If b(a(71)) = 0 Then b(a(71)) = a(71): c(71) = a(71) Else GoTo 710
For j92 = m1 To m2
If b(a1(j92)) = 0 Then b(a1(j92)) = a1(j92): c(92) = a1(j92) Else GoTo 920
a(92) = a1(j92)
For j82 = m2 To m1 Step -1
If b(a1(j82)) = 0 Then b(a1(j82)) = a1(j82): c(82) = a1(j82) Else GoTo 820
a(82) = a1(j82)
a(72) = s3 - a(82) - a(92)
If a(72) < a1(m1) Or a(72) > a1(m2) Then GoTo 720:
If b1(a(72)) = 0 Then GoTo 720
If b(a(72)) = 0 Then b(a(72)) = a(72): c(72) = a(72) Else GoTo 720
For j93 = m1 To m2
If b(a1(j93)) = 0 Then b(a1(j93)) = a1(j93): c(93) = a1(j93) Else GoTo 930
a(93) = a1(j93)
For j83 = m2 To m1 Step -1
If b(a1(j83)) = 0 Then b(a1(j83)) = a1(j83): c(83) = a1(j83) Else GoTo 830
a(83) = a1(j83)
a(73) = s3 - a(83) - a(93)
If a(73) < a1(m1) Or a(73) > a1(m2) Then GoTo 730:
If b1(a(73)) = 0 Then GoTo 730
If b(a(73)) = 0 Then b(a(73)) = a(73): c(73) = a(73) Else GoTo 730
For j94 = m1 To m2
If b(a1(j94)) = 0 Then b(a1(j94)) = a1(j94): c(94) = a1(j94) Else GoTo 940
a(94) = a1(j94)
For j84 = m2 To m1 Step -1
If b(a1(j84)) = 0 Then b(a1(j84)) = a1(j84): c(84) = a1(j84) Else GoTo 840
a(84) = a1(j84)
a(74) = s3 - a(84) - a(94)
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
For j95 = m2 To m1 Step -1
If b(a1(j95)) = 0 Then b(a1(j95)) = a1(j95): c(95) = a1(j95) Else GoTo 950
a(95) = a1(j95)
For j85 = m2 To m1 Step -1
If b(a1(j85)) = 0 Then b(a1(j85)) = a1(j85): c(85) = a1(j85) Else GoTo 850
a(85) = a1(j85)
a(75) = s3 - a(85) - a(95)
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
For j96 = m1 To m2
If b(a1(j96)) = 0 Then b(a1(j96)) = a1(j96): c(96) = a1(j96) Else GoTo 960
a(96) = a1(j96)
For j86 = m1 To m2
If b(a1(j86)) = 0 Then b(a1(j86)) = a1(j86): c(86) = a1(j86) Else GoTo 860
a(86) = a1(j86)
a(76) = s3 - a(86) - a(96)
If a(76) < a1(m1) Or a(76) > a1(m2) Then GoTo 760:
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
a(97) = s1 - a(100) - a(99) - a(98) - a(96) - a(95) - a(94) - a(93) - a(92) - a(91)
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(87) = s1 - a(90) - a(89) - a(88) - a(86) - a(85) - a(84) - a(83) - a(82) - a(81)
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(77) = s1 - a(80) - a(79) - a(78) - a(76) - a(75) - a(74) - a(73) - a(72) - a(71)
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
n9 = n9 + 1: GoSub 2650: End
b(c(77)) = 0: c(77) = 0
770 b(c(87)) = 0: c(87) = 0
870 b(c(97)) = 0: c(97) = 0
970 b(c(76)) = 0: c(76) = 0
760 b(c(86)) = 0: c(86) = 0
860 Next j86
b(c(96)) = 0: c(96) = 0
960 Next j96
b(c(75)) = 0: c(75) = 0
750 b(c(85)) = 0: c(85) = 0
850 Next j85
b(c(95)) = 0: c(95) = 0
950 Next j95
b(c(74)) = 0: c(74) = 0
740 b(c(84)) = 0: c(84) = 0
840 Next j84
b(c(94)) = 0: c(94) = 0
940 Next j94
b(c(73)) = 0: c(73) = 0
730 b(c(83)) = 0: c(83) = 0
830 Next j83
b(c(93)) = 0: c(93) = 0
930 Next j93
b(c(72)) = 0: c(72) = 0
720 b(c(82)) = 0: c(82) = 0
820 Next j82
b(c(92)) = 0: c(92) = 0
920 Next j92
b(c(71)) = 0: c(71) = 0
710 b(c(81)) = 0: c(81) = 0
810 Next j81
b(c(91)) = 0: c(91) = 0
910 Next j91
b(c(98)) = 0: c(98) = 0
980 b(c(88)) = 0: c(88) = 0
880 Next j88
b(c(90)) = 0: c(90) = 0
900 b(c(80)) = 0: c(80) = 0
800 Next j80
b(c(99)) = 0: c(99) = 0
990 b(c(79)) = 0: c(79) = 0
790 Next j79
b(c(68)) = 0: c(68) = 0
680 b(c(69)) = 0: c(69) = 0
690 Next j69
b(c(70)) = 0: c(70) = 0
700 Next j70
b(c(58)) = 0: c(58) = 0
580 b(c(59)) = 0: c(59) = 0
590 Next j59
b(c(60)) = 0: c(60) = 0
600 Next j60
b(c(48)) = 0: c(48) = 0
480 b(c(49)) = 0: c(49) = 0
490 Next j49
b(c(50)) = 0: c(50) = 0
500 Next j50
b(c(38)) = 0: c(38) = 0
380
b(c(40)) = 0: c(40) = 0
400 Next j40
b(c(39)) = 0: c(39) = 0
390 Next j39
b(c(28)) = 0: c(28) = 0
280 b(c(29)) = 0: c(29) = 0
290 Next j29
b(c(30)) = 0: c(30) = 0
300 Next j30
b(c(18)) = 0: c(18) = 0
180 b(c(19)) = 0: c(19) = 0
190 Next j19
b(c(20)) = 0: c(20) = 0
200 Next j20
b(c(8)) = 0: c(8) = 0
80 b(c(9)) = 0: c(9) = 0
90 Next j9
b(c(10)) = 0: c(10) = 0
100 Next j10
b(c(78)) = 0: c(78) = 0
780 b(c(89)) = 0: c(89) = 0
890 Next j89
b(c(100)) = 0: c(100) = 0
1000 Next j100
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine MgcSqr0214")
End
' Print results (squares)
2650
n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 11: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 11
End If
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(s1)
i3 = 0
For i1 = 1 To 10
For i2 = 1 To 10
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
End Sub
