' Calculates 4 x 4 Magic Squares of Squares
' Seiji Tomita (2018)

' Tested with Office 2007 under Windows 7

```Sub SqrSqr4b()

Dim a(16), s(10)

y = MsgBox("Locked", vbCritical, "Routine SqrsSqrs4a")
End

n1 = 0: n9 = 0: n10 = 0: k1 = 1: k2 = 1

For j11 = 1 To 10

k = j11: GoSub 100                     'Select Subroutine: 100 ... 1100

GoSub 850: If fl1 = 0 Then GoTo 110    'Check Identical Numbers
GoSub 950: If fl1 = 0 Then GoTo 110    'Check Magic  Properties (Back Check)

n9 = n9 + 1: GoSub 650                 'Print

110 Next j11

End

' Solution #1

100 s1 = 50 * (k^2 + 337)

a(1) = (2 * k + 105)^2: a(2) = (3 * k + 38)^2:   a(3) = (6 * k - 59)^2:  a(4) = (k + 30)^2
a(5) = (k - 66)^2:      a(6) = (6 * k + 5)^2:    a(7) = (3 * k + 70)^2:  a(8) = (2 * k - 87)^2
a(9) = (3 * k - 38)^2:  a(10) = (2 * k - 105)^2: a(11) = (k - 30)^2:     a(12) = (6 * k + 59)^2
a(13) = (6 * k - 5)^2:  a(14) = (k + 66)^2:      a(15) = (2 * k + 87)^2: a(16) = (3 * k - 70)^2

Return

' Solution #2

200 s1 = 130 * (k^2 + 281)

a(1) = (3 * k + 154)^2: a(2) = (6 * k + 13)^2:   a(3) = (9 * k - 78)^2:   a(4) = (2 * k + 81)^2
a(5) = (2 * k - 111)^2: a(6) = (9 * k + 18)^2:   a(7) = (6 * k + 77)^2:   a(8) = (3 * k - 134)^2
a(9) = (6 * k - 13)^2:  a(10) = (3 * k - 154)^2: a(11) = (2 * k - 81)^2:  a(12) = (9 * k + 78)^2
a(13) = (9 * k - 18)^2: a(14) = (2 * k + 111)^2: a(15) = (3 * k + 134)^2: a(16) = (6 * k - 77)^2

Return

' Solution #3

300 s1 = 125 * (k^2 + 373)

a(1) = (4 * k + 165)^2: a(2) = (6 * k + 2)^2:    a(3) = (8 * k - 114)^2:  a(4) = (3 * k + 80)^2
a(5) = (3 * k - 136)^2: a(6) = (8 * k + 30)^2:   a(7) = (6 * k + 110)^2:  a(8) = (4 * k - 123)^2
a(9) = (6 * k - 2)^2:   a(10) = (4 * k - 165)^2: a(11) = (3 * k - 80)^2:  a(12) = (8 * k + 114)^2
a(13) = (8 * k - 30)^2: a(14) = (3 * k + 136)^2: a(15) = (4 * k + 123)^2: a(16) = (6 * k - 110)^2

Return

' Solution #4

400 s1 = 130 * (2 * k^2 + 53)

a(1) = (3 * k + 70)^2:  a(2) = (5 * k + 33)^2:  a(3) = (15 * k - 26)^2: a(4) = (k + 15)^2
a(5) = (k - 30)^2:      a(6) = (15 * k + 1)^2:  a(7) = (5 * k + 42)^2:  a(8) = (3 * k - 65)^2
a(9) = (5 * k - 33)^2:  a(10) = (3 * k - 70)^2: a(11) = (k - 15)^2:     a(12) = (15 * k + 26)^2
a(13) = (15 * k - 1)^2: a(14) = (k + 30)^2:     a(15) = (3 * k + 65)^2: a(16) = (5 * k - 42)^2

Return

' Solution #5

500 s1 = 145 * (k^2 + 74)

a(1) = (4 * k + 80)^2:  a(2) = (5 * k + 36)^2:  a(3) = (10 * k - 53)^2: a(4) = (2 * k + 15)^2
a(5) = (2 * k - 55)^2:  a(6) = (10 * k + 3)^2:  a(7) = (5 * k + 64)^2:  a(8) = (4 * k - 60)^2
a(9) = (5 * k - 36)^2:  a(10) = (4 * k - 80)^2: a(11) = (2 * k - 15)^2: a(12) = (10 * k + 53)^2
a(13) = (10 * k - 3)^2: a(14) = (2 * k + 55)^2: a(15) = (4 * k + 60)^2: a(16) = (5 * k - 64)^2

Return

' Solution #6

600 s1 = 340 * (k^2 + 29)

a(1) = (5 * k + 81)^2:  a(2) = (9 * k + 15)^2:  a(3) = (15 * k - 43)^2: a(4) = (3 * k + 35)^2
a(5) = (3 * k - 55)^2:  a(6) = (15 * k + 7)^2:  a(7) = (9 * k + 45)^2:  a(8) = (5 * k - 69)^2
a(9) = (9 * k - 15)^2:  a(10) = (5 * k - 81)^2: a(11) = (3 * k - 35)^2: a(12) = (15 * k + 43)^2
a(13) = (15 * k - 7)^2: a(14) = (3 * k + 55)^2: a(15) = (5 * k + 69)^2: a(16) = (9 * k - 45)^2

Return

' Solution #7

700 s1 = 290 * (2 * k^2 + 37)

a(1) = (7 * k + 81)^2:  a(2) = (9 * k + 42)^2:  a(3) = (21 * k - 47)^2: a(4) = (3 * k + 14)^2
a(5) = (3 * k - 49)^2:  a(6) = (21 * k + 2)^2:  a(7) = (9 * k + 63)^2:  a(8) = (7 * k - 66)^2
a(9) = (9 * k - 42)^2:  a(10) = (7 * k - 81)^2: a(11) = (3 * k - 14)^2: a(12) = (21 * k + 47)^2
a(13) = (21 * k - 2)^2: a(14) = (3 * k + 49)^2: a(15) = (7 * k + 66)^2: a(16) = (9 * k - 63)^2

Return

' Solution #8

800 s1 = 130 * (k^2 + 281)

a(1) = (2 * k + 165)^2: a(2) = (5 * k + 34)^2:   a(3) = (10 * k - 57)^2:  a(4) = (k + 70)^2
a(5) = (k - 90)^2:      a(6) = (10 * k + 7)^2:   a(7) = (5 * k + 66)^2:   a(8) = (2 * k - 155)^2
a(9) = (5 * k - 34)^2:  a(10) = (2 * k - 165)^2: a(11) = (k - 70)^2:      a(12) = (10 * k + 57)^2
a(13) = (10 * k - 7)^2: a(14) = (k + 90)^2:      a(15) = (2 * k + 155)^2: a(16) = (5 * k - 66)^2

Return

' Solution #9

900 s1 = 221 * (k^2 + 85)

a(1) = (3 * k + 112)^2:  a(2) = (8 * k + 6)^2:    a(3) = (12 * k - 43)^2:  a(4) = (2 * k + 66)^2
a(5) = (2 * k - 78)^2:   a(6) = (12 * k + 11)^2:  a(7) = (8 * k + 42)^2:   a(8) = (3 * k - 104)^2
a(9) = (8 * k - 6)^2:    a(10) = (3 * k - 112)^2: a(11) = (2 * k - 66)^2:  a(12) = (12 * k + 43)^2
a(13) = (12 * k - 11)^2: a(14) = (2 * k + 78)^2:  a(15) = (3 * k + 104)^2: a(16) = (8 * k - 42)^2

Return

' Solution #10

1000 s1 = 481 * (k^2 + 50)

a(1) = (3 * k + 128)^2: a(2) = (12 * k + 4)^2:   a(3) = (18 * k - 33)^2:  a(4) = (2 * k + 81)^2
a(5) = (2 * k - 87)^2:  a(6) = (18 * k + 9)^2:   a(7) = (12 * k + 32)^2:  a(8) = (3 * k - 124)^2
a(9) = (12 * k - 4)^2:  a(10) = (3 * k - 128)^2: a(11) = (2 * k - 81)^2:  a(12) = (18 * k + 33)^2
a(13) = (18 * k - 9)^2: a(14) = (2 * k + 87)^2:  a(15) = (3 * k + 124)^2: a(16) = (12 * k - 32)^2

Return

' Solution #11

1100 s1 = 325 * (k^2 + 149)

a(1) = (8 * k + 162)^2:  a(2) = (9 * k + 24)^2:   a(3) = (12 * k - 143)^2: a(4) = (6 * k + 34)^2
a(5) = (6 * k - 146)^2:  a(6) = (12 * k + 17)^2:  a(7) = (9 * k + 144)^2:  a(8) = (8 * k - 78)^2
a(9) = (9 * k - 24)^2:   a(10) = (8 * k - 162)^2: a(11) = (6 * k - 34)^2:  a(12) = (12 * k + 143)^2
a(13) = (12 * k - 17)^2: a(14) = (6 * k + 146)^2: a(15) = (8 * k + 78)^2:  a(16) = (9 * k - 144)^2

Return

'   Print results (selected numbers)

640 For i1 = 1 To 16
Cells(n9, i1).Value = a(i1)
Next i1

Return

'   Print results (squares)

650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 5: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 5
End If

Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(s1) + ", " + CStr(n9)

i3 = 0
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1

Return

'   Exclude solutions with identical numbers
'   Exclude a(i1) = 0

850 fl1 = 1
For j1 = 1 To 16
a2 = a(j1): If a2 = 0 Then fl1 = 0: Return
For j2 = (1 + j1) To 16
If a2 = a(j2) Then fl1 = 0: Return
Next j2
Next j1
Return

'   Check Magic Properties

950 fl1 = 1

s(1) = a(1) + a(2) + a(3) + a(4)
s(1) = a(1) + a(2) + a(3) + a(4)
s(2) = a(5) + a(6) + a(7) + a(8)
s(3) = a(9) + a(10) + a(11) + a(12)
s(4) = a(13) + a(14) + a(15) + a(16)

s(5) = a(1) + a(5) + a(9) + a(13)
s(6) = a(2) + a(6) + a(10) + a(14)
s(7) = a(3) + a(7) + a(11) + a(15)
s(8) = a(4) + a(8) + a(12) + a(16)

s(9) = a(1) + a(6) + a(11) + a(16)
s(10) = a(4) + a(7) + a(10) + a(13)

For j20 = 1 To 10
If s(j20) <> s1 Then fl1 = 0: Exit For
Next j20

Return

End Sub
```