About the Author

' Generates Magic Squares of order 3

' Tested with Office 2007 under Windows 7

DefInt F, J, N, S

Sub MgcSqr3()

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

Dim s(12)

'
'   Possible solution: 9 * (1 + 9) / (2 * 3) = 15
'
    N = 0: n1 = 0: k1 = 0: k2 = 0
    t1 = Timer
   
    For j1 = 1 To 9
    For j2 = 1 To 9
        If j2 = j1 Then GoTo 170
    For j3 = 1 To 9
        If j3 = j2 Or j3 = j1 Then GoTo 160
    For j4 = 1 To 9
        If j4 = j3 Or j4 = j2 Or j4 = j1 Then GoTo 150
    For j5 = 1 To 9
        If j5 = j4 Or j5 = j3 Or j5 = j2 Or j5 = j1 Then GoTo 140
    For j6 = 1 To 9
        If j6 = j5 Or j6 = j4 Or j6 = j3 Or j6 = j2 Or j6 = j1 Then GoTo 130
    For j7 = 1 To 9
        If j7 = j6 Or j7 = j5 Or j7 = j4 Or j7 = j3 Or j7 = j2 Or j7 = j1 Then GoTo 120
    For j8 = 1 To 9
        If j8 = j7 Or j8 = j6 Or j8 = j5 Or j8 = j4 Or j8 = j3 Or j8 = j2 Or j8 = j1 Then GoTo 110
    For j9 = 1 To 9
        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 100

        GoSub 500       'Check Magic Squares
'        GoSub 550       'Check Squares with only Columns summing to 15 (for construction of 9 x 9 Pan Magic Squares)

        If fl = 1 Then
            N = N + 1
'           GoSub 640   'Print results (selected numbers)
            GoSub 650   'Print results (squares)
        End If

100 Next j9
110 Next j8
120 Next j7
130 Next j6
140 Next j5
150 Next j4
160 Next j3
170 Next j2
180 Next j1
   
    t2 = Timer
    t10 = Str(t2 - t1) + " sec., " + Str(N) + " Solutions for sum 15"
    y = MsgBox(t10 , 0, "Magic Squares 3")
       
    End

'   j1,j2,j3
'   j4,j5,j6
'   j7,j8,j9

'   Check Magic Squares

500 s(1) = j1 + j2 + j3
    s(2) = j4 + j5 + j6: If s(1) <> s(2) Then fl = 0: Return
    s(3) = j7 + j8 + j9: If s(1) <> s(3) Then fl = 0: Return
    s(4) = j1 + j4 + j7: If s(1) <> s(4) Then fl = 0: Return
    s(5) = j2 + j5 + j8: If s(1) <> s(5) Then fl = 0: Return
    s(6) = j3 + j6 + j9: If s(1) <> s(6) Then fl = 0: Return
    s(7) = j1 + j5 + j9: If s(1) <> s(7) Then fl = 0: Return
    s(8) = j3 + j5 + j7: If s(1) <> s(8) Then fl = 0: Return
    fl = 1
    Return

'   Check Squares with only Columns summing to 15 (for construction of 9 x 9 Pan Magic Squares)

550 s(4) = j1 + j4 + j7: If s(4) <> 15 Then fl = 0: Return
    s(5) = j2 + j5 + j8: If s(5) <> 15 Then fl = 0: Return
    s(6) = j3 + j6 + j9: If s(6) <> 15 Then fl = 0: Return
    fl = 1
    Return

'   Print results (selected numbers)

640 Cells(N, 1).Value = j1
    Cells(N, 2).Value = j2
    Cells(N, 3).Value = j3
    Cells(N, 4).Value = j4
    Cells(N, 5).Value = j5
    Cells(N, 6).Value = j6
    Cells(N, 7).Value = j7
    Cells(N, 8).Value = j8
    Cells(N, 9).Value = j9
    Return

'   Print results (squares)

650 n1 = n1 + 1
    If n1 = 5 Then
        n1 = 1: k1 = k1 + 4: k2 = 0
    Else
        If N > 1 Then k2 = k2 + 4
    End If
    Cells(k1 + 1, k2 + 1).Value = j1: Cells(k1 + 1, k2 + 2).Value = j2: Cells(k1 + 1, k2 + 3).Value = j3
    Cells(k1 + 2, k2 + 1).Value = j4: Cells(k1 + 2, k2 + 2).Value = j5: Cells(k1 + 2, k2 + 3).Value = j6
    Cells(k1 + 3, k2 + 1).Value = j7: Cells(k1 + 3, k2 + 2).Value = j8: Cells(k1 + 3, k2 + 3).Value = j9
    Return

End Sub

About the Author