About the Author

' Constructs Prime Number Magic Squares of order 3

' Tested with Office 2007 under Windows 7

```Sub CnstrSqrs3b()

Dim a2(3), b2(3), a(9), b(9), c(9)

y = MsgBox("Locked", vbExclamation, "Routine CnstrSqrs3b")
End

n2 = 0: n9 = 0: k1 = 1: k2 = 1

Sheets("Klad1").Select

t1 = Timer

For j1 = 3 To 18

'   Read Magic Lines

For j2 = 1 To 3: a2(j2) = Sheets("Solutions321").Cells(j1, j2).Value: Next j2
For j2 = 1 To 3: b2(j2) = Sheets("Solutions321").Cells(j1, j2 + 4).Value: Next j2
s1 = Sheets("Solutions321").Cells(j1, 11).Value

'   Construct squares a() and b()

a(1) = a2(3):   a(2) = a2(1):   a(3) = a2(2):
a(4) = a2(1):   a(5) = a2(2):   a(6) = a2(3):
a(7) = a2(2):   a(8) = a2(3):   a(9) = a2(1):

b(1) = b2(2):   b(2) = b2(3):   b(3) = b2(1):
b(4) = b2(1):   b(5) = b2(2):   b(6) = b2(3):
b(7) = b2(3):   b(8) = b2(1):   b(9) = b2(2):

'   Calculate Square c()

For j2 = 1 To 9
c(j2) = a(j2) + b(j2)
Next j2

'   Print results

GoSub 800: If fl1 = 0 Then GoTo 70

'   n9 = n9 + 1: GoSub 640  'Lines
n9 = n9 + 1: GoSub 650  'Squares

70 Next j1

t2 = Timer

t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, vbInformation, "Routine CnstrSqrs3b")

End

'   Exclude solutions with identical numbers

800 fl1 = 1
For j10 = 1 To 9
c2 = c(j10)
For j20 = (1 + j10) To 9
If c2 = c(j20) Then fl1 = 0: Return
Next j20
Next j10
Return

'   Print results (selected numbers)

640 Cells(n9, 10).Select
For i1 = 1 To 9
Cells(n9, i1).Value = c(i1)
Next i1
Cells(n9, 10).Value = n9
Return

'   Print results (squares)

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

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

i3 = 0
For i1 = 1 To 3
For i2 = 1 To 3
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = c(i3)
Next i2
Next i1
Return

End Sub
```

 About the Author