' Completes Order 10 Inlaid Magic Squares
' Order 4 Pan Magic Square Inlays (4 ea)
' Tested with Office 365 under Windows 10
Sub Inlaid104()
Dim a(104), a1(100), b1(100), b(100), c(100)
Dim a8(64)
k1 = 1: k2 = 1
y = MsgBox("Blocked", vbCritical, "Inlaid104")
End
For j110 = 64 To 64
' Define Range
Erase b1
For i1 = 1 To 100
x = Sheets("Ranges10").Cells(i1 + 1, 1).Value
b1(x) = x
Next i1
s1 = Sheets("Ranges10").Cells(1, 1).Value
' Read Order 4 Pm Sub Square
Erase a
For i1 = 1 To 64
a8(i1) = Sheets("Pm44").Cells(j110, i1).Value
Next i1
a(12) = a8(1): a(13) = a8(2): a(14) = a8(3): a(15) = a8(4): a(16) = a8(5): a(17) = a8(6): a(18) = a8(7): a(19) = a8(8):
a(22) = a8(9): a(23) = a8(10): a(24) = a8(11): a(25) = a8(12): a(26) = a8(13): a(27) = a8(14): a(28) = a8(15): a(29) = a8(16):
a(32) = a8(17): a(33) = a8(18): a(34) = a8(19): a(35) = a8(20): a(36) = a8(21): a(37) = a8(22): a(38) = a8(23): a(39) = a8(24):
a(42) = a8(25): a(43) = a8(26): a(44) = a8(27): a(45) = a8(28): a(46) = a8(29): a(47) = a8(30): a(48) = a8(31): a(49) = a8(32):
a(52) = a8(33): a(53) = a8(34): a(54) = a8(35): a(55) = a8(36): a(56) = a8(37): a(57) = a8(38): a(58) = a8(39): a(59) = a8(40):
a(62) = a8(41): a(63) = a8(42): a(64) = a8(43): a(65) = a8(44): a(66) = a8(45): a(67) = a8(46): a(68) = a8(47): a(69) = a8(48):
a(72) = a8(49): a(73) = a8(50): a(74) = a8(51): a(75) = a8(52): a(76) = a8(53): a(77) = a8(54): a(78) = a8(55): a(79) = a8(56):
a(82) = a8(57): a(83) = a8(58): a(84) = a8(59): a(85) = a8(60): a(86) = a8(61): a(87) = a8(62): a(88) = a8(63): a(89) = a8(64):
a(101) = a(12) + a(13) + a(14) + a(15)
a(102) = a(16) + a(17) + a(18) + a(19)
a(103) = a(52) + a(53) + a(54) + a(55)
a(104) = a(56) + a(57) + a(58) + a(59)
' Define Available Integers
For i1 = 1 To 100
If a(i1) <> 0 Then b1(a(i1)) = 0
Next i1
i2 = 0
For i1 = 1 To 100
If b1(i1) = i1 Then
i2 = i2 + 1: a1(i2) = i1
End If
Next i1
m1 = 1: m2 = i2
For j100 = m1 To m2 'a(100)
If b(a1(j100)) = 0 Then b(a1(j100)) = a1(j100): c(100) = a1(j100) Else GoTo 1000
a(100) = a1(j100)
a(1) = s1 - a(100) - a(101) - a(104)
If a(1) < a1(m1) Or a(1) > a1(m2) Then GoTo 10
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 j99 = m1 To m2 'a(99)
If b(a1(j99)) = 0 Then b(a1(j99)) = a1(j99): c(99) = a1(j99) Else GoTo 990
a(99) = a1(j99)
a(9) = s1 - a(99) - a(102) - a(104)
If a(9) < a1(m1) Or a(9) > a1(m2) Then GoTo 90
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
For j98 = j99 + 1 To m2 'a(98)
If b(a1(j98)) = 0 Then b(a1(j98)) = a1(j98): c(98) = a1(j98) Else GoTo 980
a(98) = a1(j98)
a(8) = s1 - a(98) - a(102) - a(104)
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 j97 = j98 + 1 To m2 'a(97)
If b(a1(j97)) = 0 Then b(a1(j97)) = a1(j97): c(97) = a1(j97) Else GoTo 970
a(97) = a1(j97)
a(7) = s1 - a(97) - a(102) - a(104)
If a(7) < a1(m1) Or a(7) > a1(m2) Then GoTo 70
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 j96 = j97 + 1 To m2 'a(96)
If b(a1(j96)) = 0 Then b(a1(j96)) = a1(j96): c(96) = a1(j96) Else GoTo 960
a(96) = a1(j96)
a(6) = s1 - a(96) - a(102) - a(104)
If a(6) < a1(m1) Or a(6) > a1(m2) Then GoTo 60
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 j95 = m1 To m2 'a(95)
If b(a1(j95)) = 0 Then b(a1(j95)) = a1(j95): c(95) = a1(j95) Else GoTo 950
a(95) = a1(j95)
a(5) = s1 - a(95) - a(101) - a(103)
If a(5) < a1(m1) Or a(5) > a1(m2) Then GoTo 50
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 j94 = j95 + 1 To m2 'a(94)
If b(a1(j94)) = 0 Then b(a1(j94)) = a1(j94): c(94) = a1(j94) Else GoTo 940
a(94) = a1(j94)
a(4) = s1 - a(94) - a(101) - a(103)
If a(4) < a1(m1) Or a(4) > a1(m2) Then GoTo 40
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 j93 = j94 + 1 To m2 'a(93)
If b(a1(j93)) = 0 Then b(a1(j93)) = a1(j93): c(93) = a1(j93) Else GoTo 930
a(93) = a1(j93)
a(3) = s1 - a(93) - a(101) - a(103)
If a(3) < a1(m1) Or a(3) > a1(m2) Then GoTo 30
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 j92 = j93 + 1 To m2 'a(92)
If b(a1(j92)) = 0 Then b(a1(j92)) = a1(j92): c(92) = a1(j92) Else GoTo 920
a(92) = a1(j92)
a(2) = s1 - a(92) - a(101) - a(103)
If a(2) < a1(m1) Or a(2) > a1(m2) Then GoTo 20
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
a(91) = s1 - a(92) - a(93) - a(94) - a(95) - a(96) - a(97) - a(98) - a(99) - a(100)
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(10) = s1 - a(91) - a(102) - a(103)
If a(10) < a1(m1) Or a(10) > a1(m2) Then GoTo 100
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
For j90 = m1 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(81) = s1 - a(90) - a(103) - a(104)
If a(81) < a1(m1) Or a(81) > a1(m2) Then GoTo 810
If b1(a(81)) = 0 Then GoTo 810
If b(a(81)) = 0 Then b(a(81)) = a(81): c(81) = a(81) Else GoTo 810
For j80 = j90 + 1 To m2 'a(80)
If b(a1(j80)) = 0 Then b(a1(j80)) = a1(j80): c(80) = a1(j80) Else GoTo 800
a(80) = a1(j80)
a(71) = s1 - a(80) - a(103) - a(104)
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 j70 = j80 + 1 To m2 'a(70)
If b(a1(j70)) = 0 Then b(a1(j70)) = a1(j70): c(70) = a1(j70) Else GoTo 700
a(70) = a1(j70)
a(61) = s1 - a(70) - a(103) - a(104)
If a(61) < a1(m1) Or a(61) > a1(m2) Then GoTo 610
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 j60 = j70 + 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(51) = s1 - a(60) - a(103) - a(104)
If a(51) < a1(m1) Or a(51) > a1(m2) Then GoTo 510
If b1(a(51)) = 0 Then GoTo 510
If b(a(51)) = 0 Then b(a(51)) = a(51): c(51) = a(51) Else GoTo 510
For j50 = m1 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(41) = s1 - a(50) - a(101) - a(102)
If a(41) < a1(m1) Or a(41) > a1(m2) Then GoTo 410
If b1(a(41)) = 0 Then GoTo 410
If b(a(41)) = 0 Then b(a(41)) = a(41): c(41) = a(41) Else GoTo 410
For j40 = m1 To m2 'a(40)
If b(a1(j40)) = 0 Then b(a1(j40)) = a1(j40): c(40) = a1(j40) Else GoTo 400
a(40) = a1(j40)
a(31) = s1 - a(40) - a(101) - a(102)
If a(31) < a1(m1) Or a(31) > a1(m2) Then GoTo 310
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 j30 = m1 To m2 'a(30)
If b(a1(j30)) = 0 Then b(a1(j30)) = a1(j30): c(30) = a1(j30) Else GoTo 300
a(30) = a1(j30)
a(21) = s1 - a(30) - a(101) - a(102)
If a(21) < a1(m1) Or a(21) > a1(m2) Then GoTo 210
If b1(a(21)) = 0 Then GoTo 210
If b(a(21)) = 0 Then b(a(21)) = a(21): c(21) = a(21) Else GoTo 210
a(20) = -a(30) - a(40) - a(50) - a(60) - a(70) - a(80) - a(90) + a(91) - a(100) + a(102) + a(103)
If a(20) < a1(m1) Or a(20) > a1(m2) Then GoTo 200
If b1(a(20)) = 0 Then GoTo 200
If b(a(20)) = 0 Then b(a(20)) = a(20): c(20) = a(20) Else GoTo 200
a(11) = s1 - a(20) - a(101) - a(102)
If a(11) < a1(m1) Or a(11) > a1(m2) Then GoTo 110
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
n9 = n9 + 1: GoSub 1650: 'Print Results (Inlaid Magic Squares)
Erase b, c: GoTo 1050 'Print only first square
b(c(11)) = 0: c(11) = 0
110 b(c(20)) = 0: c(20) = 0
200 b(c(21)) = 0: c(21) = 0
210 b(c(30)) = 0: c(30) = 0
300 Next j30
b(c(31)) = 0: c(31) = 0
310 b(c(40)) = 0: c(40) = 0
400 Next j40
b(c(41)) = 0: c(41) = 0
410 b(c(50)) = 0: c(50) = 0
500 Next j50
b(c(51)) = 0: c(51) = 0
510 b(c(60)) = 0: c(60) = 0
600 Next j60
b(c(61)) = 0: c(61) = 0
610 b(c(70)) = 0: c(70) = 0
700 Next j70
b(c(71)) = 0: c(71) = 0
710 b(c(80)) = 0: c(80) = 0
800 Next j80
b(c(81)) = 0: c(81) = 0
810 b(c(90)) = 0: c(90) = 0
900 Next j90
b(c(10)) = 0: c(10) = 0
100 b(c(91)) = 0: c(91) = 0
910 b(c(2)) = 0: c(2) = 0
20 b(c(92)) = 0: c(92) = 0
920 Next j92
b(c(3)) = 0: c(3) = 0
30 b(c(93)) = 0: c(93) = 0
930 Next j93
b(c(4)) = 0: c(4) = 0
40 b(c(94)) = 0: c(94) = 0
940 Next j94
b(c(5)) = 0: c(5) = 0
50 b(c(95)) = 0: c(95) = 0
950 Next j95
b(c(6)) = 0: c(6) = 0
60 b(c(96)) = 0: c(96) = 0
960 Next j96
b(c(7)) = 0: c(7) = 0
70 b(c(97)) = 0: c(97) = 0
970 Next j97
b(c(8)) = 0: c(8) = 0
80 b(c(98)) = 0: c(98) = 0
980 Next j98
b(c(9)) = 0: c(9) = 0
90 b(c(99)) = 0: c(99) = 0
990 Next j99
b(c(1)) = 0: c(1) = 0
10 b(c(100)) = 0: c(100) = 0
1000 Next j100
1050 Next j110
y = MsgBox("Search Completed", vbExclamation, "Inlaid104")
End
' Print results (squares)
1650 n2 = n2 + 1
If n2 = 3 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 = s1
Cells(k1, k2 + 2).Value = s6
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
