' Generates Magic Squares of order 7 for integers 1 thru 49
' Bentdiagonals summing to the Magic Sum (4 Pan-Way)
' Programmer : Miguel Angel Amela, October 2012
' Tested with Office 2007 under Windows 7
Sub Amela7()
Dim a(49)
y = MsgBox("Locked", vbCritical, "Routine Amela7")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
' Generate Squares
Sheets("Klad1").Select
t1 = Timer
a1 = 1 'Define a1 here
d4 = 25
For a7 = a1 + 1 To 49
Select Case a7
Case 25: GoTo 1
End Select
a4 = 75 - a1 - a7
Select Case a4
Case Is < 1, a1, a7, 25, Is > 49: GoTo 1
End Select
g4 = a1 + a7 - d4
Select Case g4
Case Is < 1, a4, a1, a7, 25, Is > 49: GoTo 1
End Select
For g1 = a7 + 1 To 49
Select Case g1
Case g4, a4, a1, a7, 25: GoTo 2
End Select
g7 = 100 - a1 - a7 - g1
Select Case g7
Case Is < 1, g1, g4, a4, Is <= a1, a7, 25, Is > 49: GoTo 2
End Select
d1 = a7 + g7 - d4
Select Case d1
Case Is < 1, g7, g1, g4, a4, a1, a7, 25, Is > 49: GoTo 2
End Select
d7 = a1 + g1 - d4
Select Case d7
Case Is < 1, d1, g7, g1, g4, a4, a1, a7, 25, Is > 49: GoTo 2
End Select
b2c3 = 75 - a1
If b2c3 < 50 Then xb2 = 1: yb2 = b2c3 - 1
If b2c3 = 50 Then xb2 = 1: yb2 = 49
If b2c3 > 50 Then xb2 = b2c3 - 49: yb2 = 49
For b2 = xb2 To yb2
Select Case b2
Case d7, d1, g7, g1, g4, a4, a1, a7, 25: GoTo 3
End Select
c3 = b2c3 - b2
Select Case c3
Case Is < 1, b2, d7, d1, g7, g1, g4, a4, a1, a7, 25, Is > 49: GoTo 3
End Select
b6c5 = 75 - a7
If b6c5 < 50 Then xb6 = 1: yb6 = b6c5 - 1
If b6c5 = 50 Then xb6 = 1: yb6 = 49
If b6c5 > 50 Then xb6 = b6c5 - 49: yb6 = 49
For b6 = xb6 To yb6
Select Case b6
Case c3, b2, d7, d1, g7, g1, g4, a4, a1, a7, 25: GoTo 4
End Select
c5 = b6c5 - b6
Select Case c5
Case Is < 1, b6, c3, b2, d7, d1, g7, g1, g4, a4, a1, a7, 25, Is > 49: GoTo 4
End Select
f2e3 = 75 - g1
If f2e3 < 50 Then xf2 = 1: yf2 = f2e3 - 1
If f2e3 = 50 Then xf2 = 1: yf2 = 49
If f2e3 > 50 Then xf2 = f2e3 - 49: yf2 = 49
For f2 = xf2 To yf2
Select Case f2
Case c5, b6, c3, b2, d7, d1, g7, g1, g4, a4, a1, a7, 25: GoTo 5
End Select
e3 = f2e3 - f2
Select Case e3
Case Is < 1, b6, c3, b2, d7, d1, g7, g1, g4, a4, a1, a7, 25, Is > 49: GoTo 5
Case c5, f2: GoTo 5
End Select
f6 = 100 - b2 - b6 - f2
Select Case f6
Case Is < 1, b6, c3, b2, d7, d1, g7, g1, g4, a4, a1, a7, 25, Is > 49: GoTo 5
Case e3, c5, f2: GoTo 5
End Select
e5 = 75 - f6 - g7
Select Case e5
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 5
Case f6, e3, f2, c5: GoTo 5
End Select
b3b5 = 100 - b2 - b6
If b3b5 < 50 Then xb3 = 1: yb3 = b3b5 - 1
If b3b5 = 50 Then xb3 = 1: yb3 = 49
If b3b5 > 50 Then xb3 = b3b5 - 49: yb3 = 49
For b3 = xb3 To yb3
Select Case b3
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 6
Case e5: GoTo 6
End Select
b5 = b3b5 - b3
Select Case b5
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 6
Case b3, e5, f6, e3, f2, c5: GoTo 6
End Select
f3 = 100 - b3 - c3 - e3
Select Case f3
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 6
Case b5, b3, e5, f6, e3, f2, c5: GoTo 6
End Select
f5 = 100 - b5 - c5 - e5
Select Case f5
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 6
Case f3, b5, b3, e5, f6, e3, f2, c5: GoTo 6
End Select
c2c6 = 100 - c3 - c5
If c2c6 < 50 Then xc2 = 1: yc2 = c2c6 - 1
If c2c6 = 50 Then xc2 = 1: yc2 = 49
If c2c6 > 50 Then xc2 = c2c6 - 49: yc2 = 49
For c2 = xc2 To yc2
Select Case c2
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 7
Case f5, f3, b5, b3, e5: GoTo 7
End Select
c6 = c2c6 - c2
Select Case c6
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 7
Case c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 7
End Select
e2 = 100 - b2 - c2 - f2
Select Case e2
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 7
Case c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 7
End Select
e6 = 100 - b6 - c6 - f6
Select Case e6
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 7
Case e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 7
End Select
For a2 = 1 To 49
Select Case a2
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 8
Case e6, e2, c6, c2, f5, f3, b5, b3, e5: GoTo 8
End Select
g2d2 = 75 - a2
If g2d2 < 50 Then xg2 = 1: yg2 = g2d2 - 1
If g2d2 = 50 Then xg2 = 1: yg2 = 49
If g2d2 > 50 Then xg2 = g2d2 - 49: yg2 = 49
For g2 = xg2 To yg2
Select Case g2
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 9
Case a2, e6, e2, c6, c2, f5, f3, b5, b3, e5: GoTo 9
End Select
d2 = g2d2 - g2
Select Case d2
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 9
Case g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 9
End Select
d3 = 125 - c2 - d1 - d2 - e2
Select Case d3
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 9
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 9
End Select
For a6 = 1 To 49
Select Case a6
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 10
Case d3, d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5: GoTo 10
End Select
b4 = a2 + a6 - 25
Select Case b4
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 10
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 10
Case a6, d3: GoTo 10
End Select
c4 = 175 - g1 - g7 - a2 - a6 - b3 - b5
Select Case c4
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 10
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 10
Case b4, a6, d3: GoTo 10
End Select
g6d6 = 75 - a6
If g6d6 < 50 Then xg6 = 1: yg6 = g6d6 - 1
If g6d6 = 50 Then xg6 = 1: yg6 = 49
If g6d6 > 50 Then xg6 = g6d6 - 49: yg6 = 49
For g6 = xg6 To yg6
Select Case g6
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 11
Case c4, b4, a6, d3, d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5: GoTo 11
End Select
d6 = g6d6 - g6
Select Case d6
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 11
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 11
Case g6, c4, b4, a6, d3: GoTo 11
End Select
d5 = 125 - c6 - d6 - d7 - e6
Select Case d5
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 11
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 11
Case d6, g6, c4, b4, a6, d3: GoTo 11
End Select
f4 = g2 + g6 - 25
Select Case f4
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 11
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 11
Case d5, d6, g6, c4, b4, a6, d3: GoTo 11
End Select
e4 = 175 - a1 - a7 - g2 - g6 - f3 - f5
Select Case e4
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 11
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 11
Case f4, d5, d6, g6, c4, b4, a6, d3: GoTo 11
End Select
b1b7 = 100 - a2 - a6
If b1b7 < 50 Then xb1 = 1: yb1 = b1b7 - 1
If b1b7 = 50 Then xb1 = 1: yb1 = 49
If b1b7 > 50 Then xb1 = b1b7 - 49: yb1 = 49
For b1 = xb1 To yb1
Select Case b1
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 12
Case c4, b4, a6, d3, d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5: GoTo 12
Case e4, f4, d5, d6, g6: GoTo 12
End Select
b7 = b1b7 - b1
Select Case b7
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 12
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 12
Case b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 12
End Select
f1 = a6 + b7 - g2
Select Case f1
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 12
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 12
Case b7, b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 12
End Select
f7 = a2 + b1 - g6
Select Case f7
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 12
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 12
Case f1, b7, b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 12
End Select
a3a5 = 75 - b4
If a3a5 < 50 Then xa3 = 1: ya3 = a3a5 - 1
If a3a5 = 50 Then xa3 = 1: ya3 = 49
If a3a5 > 50 Then xa3 = a3a5 - 49: ya3 = 49
For a3 = xa3 To ya3
Select Case a3
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 13
Case c4, b4, a6, d3, d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5: GoTo 13
Case f7, f1, b7, b1, e4, f4, d5, d6, g6: GoTo 13
End Select
a5 = a3a5 - a3
Select Case a5
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 13
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 13
Case a3, f7, f1, b7, b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 13
End Select
g3 = 175 - a3 - b4 - c5 - d6 - e5 - f4
Select Case g3
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 13
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 13
Case a5, a3, f7, f1, b7, b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 13
End Select
g5 = 175 - a5 - b4 - c3 - d2 - e3 - f4
Select Case g5
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 13
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 13
Case g3, a5, a3, f7, f1, b7, b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 13
End Select
c1e1 = 75 - d2
If c1e1 < 50 Then xc1 = 1: yc1 = c1e1 - 1
If c1e1 = 50 Then xc1 = 1: yc1 = 49
If c1e1 > 50 Then xc1 = c1e1 - 49: yc1 = 49
For c1 = xc1 To yc1
Select Case c1
Case f6, e3, f2, c5, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25: GoTo 14
Case c4, b4, a6, d3, d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5: GoTo 14
Case g5, g3, a5, a3, f7, f1, b7, b1, e4, f4, d5, d6, g6: GoTo 14
End Select
e1 = c1e1 - c1
Select Case e1
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 14
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 14
Case g3, a5, a3, f7, f1, b7, b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 14
Case c1, g5: GoTo 14
End Select
c7 = 75 - c1 - c4
Select Case c7
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 14
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 14
Case g3, a5, a3, f7, f1, b7, b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 14
Case e1, c1, g5: GoTo 14
End Select
e7 = 100 - b7 - c7 - f7
Select Case e7
Case Is < 1, b6, c3, b2, g4, d7, d1, a4, g7, g1, a7, a1, 25, Is > 49: GoTo 14
Case d2, g2, a2, e6, e2, c6, c2, f5, f3, b5, b3, e5, f6, e3, f2, c5: GoTo 14
Case g3, a5, a3, f7, f1, b7, b1, e4, f4, d5, d6, g6, c4, b4, a6, d3: GoTo 14
Case c7, e1, c1, g5: GoTo 14
End Select
a(1) = a1: a(2) = a2: a(3) = a3: a(4) = a4: a(5) = a5: a(6) = a6: a(7) = a7:
a(8) = b1: a(9) = b2: a(10) = b3: a(11) = b4: a(12) = b5: a(13) = b6: a(14) = b7:
a(15) = c1: a(16) = c2: a(17) = c3: a(18) = c4: a(19) = c5: a(20) = c6: a(21) = c7:
a(22) = d1: a(23) = d2: a(24) = d3: a(25) = d4: a(26) = d5: a(27) = d6: a(28) = d7:
a(29) = e1: a(30) = e2: a(31) = e3: a(32) = e4: a(33) = e5: a(34) = e6: a(35) = e7:
a(36) = f1: a(37) = f2: a(38) = f3: a(39) = f4: a(40) = f5: a(41) = f6: a(42) = f7:
a(43) = g1: a(44) = g2: a(45) = g3: a(46) = g4: a(47) = g5: a(48) = g6: a(49) = g7:
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers)
14 Next
13 Next
12 Next
11 Next
10 Next
9 Next
8 Next
7 Next
6 Next
5 Next
4 Next
3 Next
2 Next
1 Next
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine Amela7")
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
End Sub
