' Generates Pan Magic Squares of order 8, Magic Sum 260, based on Matrix Operation

' Tested with Office 2007 under Windows 7

```Sub MgcSqr8a()

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

Dim A(8, 8)             'Base Square
Dim R(8, 8)             'Rotated
Dim B(8, 8)             'Resulting Square B = 8 * R + A - 8

t1 = Timer

n9 = 0: m2 = 8

For j1 = 1 To m2
For j2 = 1 To m2
If j2 = j1 Then GoTo 120
For j3 = 1 To m2
If j3 = j2 Or j3 = j1 Then GoTo 130
For j4 = 1 To m2
If j4 = j3 Or j4 = j2 Or j4 = j1 Then GoTo 140
For j5 = 1 To m2
If j5 = j4 Or j5 = j3 Or j5 = j2 Or j5 = j1 Then GoTo 150
For j6 = 1 To m2
If j6 = j5 Or j6 = j4 Or j6 = j3 Or j6 = j2 Or j6 = j1 Then GoTo 160
For j7 = 1 To m2
If j7 = j6 Or j7 = j5 Or j7 = j4 Or j7 = j3 Or j7 = j2 Or j7 = j1 Then GoTo 170
For j8 = 1 To m2
If j8 = j7 Or j8 = j6 Or j8 = j5 Or j8 = j4 Or j8 = j3 Or j8 = j2 Or j8 = j1 Then GoTo 180

GoSub 550       'Check sum of halfrow elements (=9)

If fl = 1 Then

GoSub 200   'Fill      Matrix A
GoSub 300   'Rotate    Matrix A
GoSub 400   'Calculate Matrix B = 8 * R + A - 8

n9 = n9 + 1
'                                       GoSub 645   'Print results (Selected Numbers)
GoSub 650   'Print results (Squares)

End If

180                         Next j8
170                     Next j7
160                 Next j6
150             Next j5
140         Next j4
130     Next j3
120 Next j2
110 Next j1

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

End

'   Fill Matrix A

200 A(1, 1) = j1:      A(1, 2) = j2:      A(1, 3) = j3:      A(1, 4) = j4         'First 4 columns Row 1
A(2, 1) = j5:      A(2, 2) = j6:      A(2, 3) = j7:      A(2, 4) = j8         'First 4 columns Row 2
A(3, 1) = A(1, 1): A(3, 2) = A(1, 2): A(3, 3) = A(1, 3): A(3, 4) = A(1, 4)    'First 4 columns Row 3
A(4, 1) = A(2, 1): A(4, 2) = A(2, 2): A(4, 3) = A(2, 3): A(4, 4) = A(2, 4)    'First 4 columns Row 4
A(5, 1) = A(1, 1): A(5, 2) = A(1, 2): A(5, 3) = A(1, 3): A(5, 4) = A(1, 4)    'First 4 columns Row 5
A(6, 1) = A(2, 1): A(6, 2) = A(2, 2): A(6, 3) = A(2, 3): A(6, 4) = A(2, 4)    'First 4 columns Row 6
A(7, 1) = A(1, 1): A(7, 2) = A(1, 2): A(7, 3) = A(1, 3): A(7, 4) = A(1, 4)    'First 4 columns Row 7
A(8, 1) = A(2, 1): A(8, 2) = A(2, 2): A(8, 3) = A(2, 3): A(8, 4) = A(2, 4)    'First 4 columns Row 8

For j5 = 2 To 8                                                               'Fill remainder of square
For j6 = 5 To 8
A(j5, j6) = A(j5 - 1, j6 - 4)
Next j6
Next j5
A(1, 5) = A(8, 1): A(1, 6) = A(8, 2): A(1, 7) = A(8, 3): A(1, 8) = A(8, 4)
Return

'   Rotate Matrix A

300 For i1 = 1 To m2
For i2 = 1 To m2
R(i1, i2) = A(i2, 8 - i1 + 1)
Next i2
Next i1
Return

'   Calculate Matrix B = 8 * R + A - 8

400 For i1 = 1 To m2
For i2 = 1 To m2
B(i1, i2) = 8 * R(i1, i2) + A(i1, i2) - 8
Next i2
Next i1
Return

'   Check sum of halfrow elements (=9)

550 c1 = j1 + j5: If c1 <> 9 Then fl = 0: Return
c2 = j2 + j6: If c2 <> 9 Then fl = 0: Return
c3 = j3 + j7: If c3 <> 9 Then fl = 0: Return
c4 = j4 + j8: If c4 <> 9 Then fl = 0: Return
fl = 1
Return

'   Print Results (Selected Numbers)

645 i3 = 0
For i1 = 1 To m2
For i2 = 1 To m2
i3 = i3 + 1
Cells(n9, i3).Value = B(i1, i2)
Next i2
Next i1
Return

'   Print Results (Squares)

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

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

For i1 = 1 To m2
For i2 = 1 To m2
Cells(k1 + i1, k2 + i2).Value = B(i1, i2) 'B
Next i2
Next i1

Return

End Sub
```