 About the Author

' Generates Magic Squares of order 9 for integers 1 thru 81, based on Matrix Operation

' Tested with Office 2007 under Windows 7

```Sub MgcSqr9b()

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

Dim a(9, 9)             'Base Square
Dim t(9, 9)             'Transposed
Dim b(9, 9)             'Resulting Square B = 9 * T + A - 9

t1 = Timer

n9 = 0: m2 = 9

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
For j9 = 1 To m2
If j9 = j8 Or j9 = j7 Or j9 = j6 Or j9 = j5 Or j9 = j4 Or j9 = j3 Or j9 = j2 Or j9 = j1 Then GoTo 190

GoSub 550       'Check 3 x 3 Squares with Columns summing to 15

If fl = 1 Then

GoSub 200   'Fill      Matrix A
GoSub 300   'Transpose Matrix A
GoSub 400   'Calculate Matrix B = 9 * T + A - 9

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

End If

190                             Next j9
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 MgcSqr9b")

End

'   Fill Matrix A

200 a(1, 1) = j1: a(1, 2) = j2: a(1, 3) = j3:   a(1, 4) = j7: a(1, 5) = j8: a(1, 6) = j9:   a(1, 7) = j4: a(1, 8) = j5: a(1, 9) = j6   'Row 1
a(2, 1) = j4: a(2, 2) = j5: a(2, 3) = j6:   a(2, 4) = j1: a(2, 5) = j2: a(2, 6) = j3:   a(2, 7) = j7: a(2, 8) = j8: a(2, 9) = j9   'Row 2
a(3, 1) = j7: a(3, 2) = j8: a(3, 3) = j9:   a(3, 4) = j4: a(3, 5) = j5: a(3, 6) = j6:   a(3, 7) = j1: a(3, 8) = j2: a(3, 9) = j3   'Row 3
a(4, 1) = j1: a(4, 2) = j2: a(4, 3) = j3:   a(4, 4) = j7: a(4, 5) = j8: a(4, 6) = j9:   a(4, 7) = j4: a(4, 8) = j5: a(4, 9) = j6   'Row 4
a(5, 1) = j4: a(5, 2) = j5: a(5, 3) = j6:   a(5, 4) = j1: a(5, 5) = j2: a(5, 6) = j3:   a(5, 7) = j7: a(5, 8) = j8: a(5, 9) = j9   'Row 5
a(6, 1) = j7: a(6, 2) = j8: a(6, 3) = j9:   a(6, 4) = j4: a(6, 5) = j5: a(6, 6) = j6:   a(6, 7) = j1: a(6, 8) = j2: a(6, 9) = j3   'Row 6
a(7, 1) = j1: a(7, 2) = j2: a(7, 3) = j3:   a(7, 4) = j7: a(7, 5) = j8: a(7, 6) = j9:   a(7, 7) = j4: a(7, 8) = j5: a(7, 9) = j6   'Row 7
a(8, 1) = j4: a(8, 2) = j5: a(8, 3) = j6:   a(8, 4) = j1: a(8, 5) = j2: a(8, 6) = j3:   a(8, 7) = j7: a(8, 8) = j8: a(8, 9) = j9   'Row 8
a(9, 1) = j7: a(9, 2) = j8: a(9, 3) = j9:   a(9, 4) = j4: a(9, 5) = j5: a(9, 6) = j6:   a(9, 7) = j1: a(9, 8) = j2: a(9, 9) = j3   'Row 9
Return

'   Transpose Matrix A

300 For i1 = 1 To m2
For i2 = 1 To m2
t(i1, i2) = a(i2, i1)
Next i2
Next i1
Return

'   Calculate Matrix B = 9 * T + A - 9

400 For i1 = 1 To m2
For i2 = 1 To m2
b(i1, i2) = 9 * t(i1, i2) + a(i1, i2) - 9
Next i2
Next i1
Return

'   Check 3 x 3 Squares with Columns summing to 15

550 c1 = j1 + j4 + j7: If c1 <> 15 Then fl = 0: Return
c2 = j2 + j5 + j8: If c2 <> 15 Then fl = 0: Return
c3 = j3 + j6 + j9: If c3 <> 15 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

If k1 > 0 Then
Cells(k1, k2 + 1).Font.Color = 12611584
Cells(k1, k2 + 1).Value = n9
End If

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

Return

End Sub
``` About the Author