About the Author

' Filters Magic Squares of order 7, based on sum of key variables, from collection {B}

' Tested with Office 2007 under Windows 7

Sub MgcSqr7f()

Dim a(49)

n1 = 2: n2 = 2                                'start row, column
n3 = 360                                      'number of squares to be transfered
n4 = 0: i4 = 0                                'current square

n50 = 0                                       '(start line - 1)

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

Sheets("Class07").Select

For j3 = 1 To n3                              'Square nr j3 current
    
    n4 = n4 + 1: n2 = 2 + (n4 - 1) * 8: i4 = 0
    
    For j1 = n1 To n1 + 6                     'Row    within square j3
        For j2 = n2 To n2 + 6                 'Column within square j3
            i4 = i4 + 1
            a(i4) = Sheets("Solutions733").Cells(j1, j2).Value         'load square
        Next j2
    Next j1
   
    GoSub 50                                  'transfer square j3 to Base Square
    
    If n4 = 4 Then n4 = 0: n1 = n1 + 8: n2 = 2
        
Next j3

End

'   transfer square j3 to Base Square

50  i4 = 0
    For j1 = 2 To 8
        For j2 = 2 To 8
        
            i4 = i4 + 1
            Cells(j1, j2).Value = a(i4)
    
        Next j2
    Next j1

'    y = MsgBox("Transferred " + CStr(j3), 0, "Test")

    GoSub 300                                 'check and tranfer to solution sheet (Klad1)

    Return

'   select and tranfer to solution sheet (Klad1)

300 n10 = 2: n20 = 2                          'start row, column
    n30 = 392                                 'number of squares to be checked
    n40 = 0: i40 = 0                          'current square

For j30 = 1 To n30                            'Square nr j30 current
    
    n40 = n40 + 1: n20 = 2 + (n40 - 1) * 8: i40 = 0
    
    For j10 = n10 To n10 + 6                  'Row    within square j30
        For j20 = n20 To n20 + 6              'Column within square j30
            i40 = i40 + 1
            a(i40) = Cells(j10, j20).Value    'load square
        Next j20
    Next j10

'   check sum key variables

    s2 = a(5) + a(11) + a(17) + a(23) + a(29)
    fl1 = 0: If s2 = 129 Then fl1 = 1
    
    If fl1 = 1 Then                           'sum key varaiables = 129
        Cells(n10, n20).Select
        n50 = n50 + 1
        For j10 = 1 To 49
            Sheets("Klad1").Cells(n50, j10).Value = a(j10)
        Next j10
        Sheets("Klad1").Cells(n50, 51).Value = j30
    End If
    
    If n40 = 7 Then n40 = 0: n10 = n10 + 8: n20 = 2
        
Next j30

Return

End Sub

' Transfers results to Magic Squares (7 x 7)

Sub Transfer71()

Dim a(49)

n2 = 0: n9 = 0

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

Sheets("Klad2").Select

For j3 = 1 To 2496
    n9 = n9 + 1
    For j1 = 1 To 49
        a(j1) = Sheets("Klad1").Cells(j3, j1).Value
    Next j1
    GoSub 50                                  'Print results (squares)
Next j3

End

'   Print results (squares)

50   n2 = n2 + 1
     If n2 = 5 Then
         n2 = 1: k1 = k1 + 8: k2 = 0
     Else
         If n9 > 1 Then k2 = k2 + 8
     End If
     Cells(k1 + 1, k2 + 1).Select
    
     i3 = 0
     For i1 = 1 To 7
         For i2 = 1 To 7
             i3 = i3 + 1
             Cells(k1 + i1, k2 + i2).Value = a(i3)
         Next i2
     Next i1
    Return
    
End Sub

About the Author