' Generates Pan Magic Squares of order 5, Sudoko Comparable Method

' Tested with Office 2007 under Windows 7

```Sub MgcSqr5f()

Dim A(25), B(25), C(25)

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

n2 = 0: n9 = 0

t1 = Timer

'   Define Square A

For j1 = 1 To 4
For j2 = 1 To 4
If j2 = j1 Then GoTo 20
For j3 = 1 To 4
If j3 = j2 Or j3 = j1 Then GoTo 30
For j4 = 1 To 4
If j4 = j3 Or j4 = j2 Or j4 = j1 Then GoTo 40

GoSub 50    'Define Square B

40          Next j4
30      Next j3
20  Next j2

Next j1

t2 = Timer

t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
y = MsgBox(t10, 0, "Routine MgcSqr5f")

End

'   Define Square B

50  For j5 = 2 To 4
For j6 = 2 To 4
If j6 = j5 Then GoTo 60
For j7 = 2 To 4
If j7 = j6 Or j7 = j5 Then GoTo 70

GoSub 200   'Calculate Square C
n9 = n9 + 1
'           GoSub 640   'Print     results (selected numbers)
GoSub 650   'Print     results (squares)

70      Next j7
60  Next j6
Next j5
Return

90   A(1) = 0:     A(2) = j1:    A(3) = j2:    A(4) = j3:    A(5) = j4
A(6) = A(3):  A(7) = A(4):  A(8) = A(5):  A(9) = A(1):  A(10) = A(2)
A(11) = A(5): A(12) = A(1): A(13) = A(2): A(14) = A(3): A(15) = A(4)
A(16) = A(2): A(17) = A(3): A(18) = A(4): A(19) = A(5): A(20) = A(1)
A(21) = A(4): A(22) = A(5): A(23) = A(1): A(24) = A(2): A(25) = A(3)
Return

100  B(1) = 0:     B(2) = 1:     B(3) = j5:    B(4) = j6:    B(5) = j7
B(6) = B(4):  B(7) = B(5):  B(8) = B(1):  B(9) = B(2):  B(10) = B(3)
B(11) = B(2): B(12) = B(3): B(13) = B(4): B(14) = B(5): B(15) = B(1)
B(16) = B(5): B(17) = B(1): B(18) = B(2): B(19) = B(3): B(20) = B(4)
B(21) = B(3): B(22) = B(4): B(23) = B(5): B(24) = B(1): B(25) = B(2)
Return

'    Calculate Square C

200  For j10 = 1 To 25
C(j10) = 5 * A(j10) + B(j10) + 1
Next j10
Return

'   Print results (selected numbers)

640 For i1 = 1 To 25
Cells(n9, i1).Value = C(i1)
Next i1

Return

'   Print results (squares)

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

Cells(k1 + 1, k2 + 1).Select

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

Return

End Sub
```