About the Author

' 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

Sheets("Klad1").Select
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 90    'Load   Square A
                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 100   'Load      Square B
            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

'    Load   Square A

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

'    Load   Square B

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

About the Author