' Generates the borders for Eccentric Magic Squares of order 7 for integers as defined in a1()
' Tested with Office 2007 under Windows 7
Sub MgcSqr7h()
Dim a1(24), a(49), b1(140), b(140), c(49)
y = MsgBox("Locked", vbCritical, "Routine MgcSqr7h")
End
' Defining Magic Square C (5 x 5)
a(15) = 151: a(16) = 18: a(17) = 21: a(18) = 89: a(19) = 146:
a(22) = 27: a(23) = 82: a(24) = 150: a(25) = 155: a(26) = 11:
a(29) = 143: a(30) = 159: a(31) = 15: a(32) = 20: a(33) = 88:
a(36) = 19: a(37) = 24: a(38) = 81: a(39) = 149: a(40) = 152:
a(43) = 85: a(44) = 142: a(45) = 158: a(46) = 12: a(47) = 28:
' Define Border Variable Values
a1(1) = 30: a1(2) = 34: a1(3) = 35: a1(4) = 54: a1(5) = 55: a1(6) = 56:
a1(7) = 57: a1(8) = 58: a1(9) = 63: a1(10) = 64: a1(11) = 65: a1(12) = 71:
a1(13) = 99: a1(14) = 105: a1(15) = 106: a1(16) = 107: a1(17) = 112: a1(18) = 113:
a1(19) = 114: a1(20) = 115: a1(21) = 116: a1(22) = 135: a1(23) = 136: a1(24) = 140:
For i1 = 1 To 24
b1(a1(i1)) = a1(i1)
Next i1
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 24: s1 = 595
Sheets("Klad1").Select
t1 = Timer
For j49 = m1 To m2 'a(49)
If b(a1(j49)) = 0 Then b(a1(j49)) = a1(j49): c(49) = a1(j49) Else GoTo 490
a(49) = a1(j49)
a(48) = 170 - 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 j42 = m1 To m2 'a(42)
If b(a1(j42)) = 0 Then b(a1(j42)) = a1(j42): c(42) = a1(j42) Else GoTo 420
a(42) = a1(j42)
a(41) = 170 - a(42): 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 j35 = m1 To m2 'a(35)
If b(a1(j35)) = 0 Then b(a1(j35)) = a1(j35): c(35) = a1(j35) Else GoTo 350
a(35) = a1(j35)
a(34) = 170 - a(35): If a(34) < a1(m1) Or a(34) > a1(m2) Then GoTo 340
If b1(a(34)) = 0 Then GoTo 340
If b(a(34)) = 0 Then b(a(34)) = a(34): c(34) = a(34) Else GoTo 340
For j28 = m1 To m2 'a(28)
If b(a1(j28)) = 0 Then b(a1(j28)) = a1(j28): c(28) = a1(j28) Else GoTo 280
a(28) = a1(j28)
a(27) = 170 - a(28): If a(27) < a1(m1) Or a(27) > a1(m2) Then GoTo 270
If b1(a(27)) = 0 Then GoTo 270
If b(a(27)) = 0 Then b(a(27)) = a(27): c(27) = a(27) Else GoTo 270
For j21 = m1 To m2 'a(21)
If b(a1(j21)) = 0 Then b(a1(j21)) = a1(j21): c(21) = a1(j21) Else GoTo 210
a(21) = a1(j21)
a(20) = 170 - a(21): 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
For j14 = m1 To m2 'a(14)
If b(a1(j14)) = 0 Then b(a1(j14)) = a1(j14): c(14) = a1(j14) Else GoTo 140
a(14) = a1(j14)
a(13) = -425 + a(14) + a(21) + a(28) + a(35) + a(42) + a(49)
If a(13) < a1(m1) Or a(13) > a1(m2) Then GoTo 130
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
For j12 = m1 To m2 'a(12)
If b(a1(j12)) = 0 Then b(a1(j12)) = a1(j12): c(12) = a1(j12) Else GoTo 120
a(12) = a1(j12)
For j11 = m1 To m2 'a(11)
If b(a1(j11)) = 0 Then b(a1(j11)) = a1(j11): c(11) = a1(j11) Else GoTo 110
a(11) = a1(j11)
For j10 = m1 To m2 'a(10)
If b(a1(j10)) = 0 Then b(a1(j10)) = a1(j10): c(10) = a1(j10) Else GoTo 100
a(10) = a1(j10)
a(9) = (1020 - a(10) - a(11) - a(12) - a(13) - a(14) - a(17) - a(25) - a(33) - a(41) - a(49)) / 2
j9 = CInt(a(9)): If j9 <> a(9) Then GoTo 90
If a(9) < a1(m1) Or a(9) > a1(m2) Then GoTo 90:
If b1(a(9)) = 0 Then GoTo 90
a(8) = 595 - a(9) - a(10) - a(11) - a(12) - a(13) - a(14)
If a(8) < a1(m1) Or a(8) > a1(m2) Then GoTo 90:
If b1(a(8)) = 0 Then GoTo 90
a(7) = 170 - a(13): If a(7) < a1(m1) Or a(7) > a1(m2) Then GoTo 90:
If b1(a(7)) = 0 Then GoTo 90
a(6) = 170 - a(14): If a(6) < a1(m1) Or a(6) > a1(m2) Then GoTo 90:
If b1(a(6)) = 0 Then GoTo 90
a(5) = 170 - a(12): If a(5) < a1(m1) Or a(5) > a1(m2) Then GoTo 90:
If b1(a(5)) = 0 Then GoTo 90
a(4) = 170 - a(11): If a(4) < a1(m1) Or a(4) > a1(m2) Then GoTo 90:
If b1(a(4)) = 0 Then GoTo 90
a(3) = 170 - a(10): If a(3) < a1(m1) Or a(3) > a1(m2) Then GoTo 90:
If b1(a(3)) = 0 Then GoTo 90
If a(3) + a(11) + a(19) + a(27) + a(35) <> 352 Then GoTo 90
a(2) = 170 - a(9): If a(2) < a1(m1) Or a(2) > a1(m2) Then GoTo 90:
If b1(a(2)) = 0 Then GoTo 90
a(1) = 170 - a(8): If a(1) < a1(m1) Or a(1) > a1(m2) Then GoTo 90:
If b1(a(1)) = 0 Then GoTo 90
' Exclude solutions with identical numbers
GoSub 800: If fl1 = 0 Then GoTo 90
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers)
90 b(c(10)) = 0: c(10) = 0
100 Next j10
b(c(11)) = 0: c(11) = 0
110 Next j11
b(c(12)) = 0: c(12) = 0
120 Next j12
b(c(13)) = 0: c(13) = 0
130 b(c(14)) = 0: c(14) = 0
140 Next j14
b(c(20)) = 0: c(20) = 0
200 b(c(21)) = 0: c(21) = 0
210 Next j21
b(c(27)) = 0: c(27) = 0
270 b(c(28)) = 0: c(28) = 0
280 Next j28
b(c(34)) = 0: c(34) = 0
340 b(c(35)) = 0: c(35) = 0
350 Next j35
b(c(41)) = 0: c(41) = 0
410 b(c(42)) = 0: c(42) = 0
420 Next j42
b(c(48)) = 0: c(48) = 0
480 b(c(49)) = 0: c(49) = 0
490 Next j49
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
y = MsgBox(t10, 0, "Routine MgcSqr7h")
End
' Print results (selected numbers)
2645 For i1 = 1 To 49
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 8: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 8
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 7
For i2 = 1 To 7
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
' Exclude solutions with identical numbers
800 fl1 = 1
For j1 = 1 To 49
a2 = a(j1)
For j2 = (1 + j1) To 49
If a2 = a(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
End Sub
