 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
Next j10
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

For j3 = 1 To 2496
n9 = n9 + 1
For j1 = 1 To 49
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