' Generates Octanary Squares {B2} for integers 0 thru 7 with following properties:
' - All 4 x 4 Sub Squares, including wrap around, sum to two times the Magic Sum;
' - The 2 x 4 rectangles from left to right sum (partly) to the Magic Sum;
' - The 4 x 2 rectangles from top to bottom sum (partly) to the Magic Sum;
' - The corner points of all 5 x 5 Sub Squares, including wrap around, sum to half the Magic Sum;
' - Sudoku Comparable Main Diagonals and Rows;
' - The two left and two right Sub Squares are identical:
' - Each set (2) of Diagonal Sub Squares (2 x 2) within a Sub Square (4 x 4) contains the same integers;
' - The collection {B1} consists of the diagonal mirrored elements of {B2}.

' Tested with Office 2007 under Windows 7

```Sub Sudoku8c()

Dim a(64), b(8)

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

n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 0: m2 = 7: s1 = 28

'   Generate data

t1 = Timer

For j64 = m1 To m2                                            'a(64) = 6
a(64) = j64

For j63 = m1 To m2                                            'a(63) = 5
If j63 = j64 Then GoTo 630
a(63) = j63

For j56 = m1 To m2                                            'a(56) = 3
a(56) = j56

For j55 = m1 To m2                                            'a(55) = 0
If j55 = j56 Then GoTo 550
a(55) = j55

For j62 = m1 To m2                                            'a(62) = 3
If j62 = j63 Or j62 = j64 Then GoTo 620
a(62) = j62

For j61 = m1 To m2                                            'a(60) = 0
If j61 = j62 Or j61 = j63 Or j61 = j64 Then GoTo 610
a(61) = j61

For j54 = m1 To m2                                            'a(54) = 6
If j54 = j55 Or j54 = j56 Then GoTo 540
a(54) = j54

a(53) = s1 - a(54) - a(55) - a(56) - a(61) - a(62) - a(63) - a(64)
If a(53) < m1 Or a(53) > m2 Then GoTo 540
If a(53) = a(54) Or j54 = a(55) Or j54 = a(56) Then GoTo 540

For j48 = m1 To m2                                            'a(48) = 0
a(48) = j48
i = 48: GoSub 1880: If fl1 = 0 Then GoTo 480

a(40) = s1 / 2 - a(48) - a(56) - a(64):  If a(40) < m1 Or a(40) > m2 Then GoTo 480
i = 40: GoSub 1880: If fl1 = 0 Then GoTo 480
a(36) = -s1 / 4 + a(48) + a(56) + a(64): If a(36) < m1 Or a(36) > m2 Then GoTo 480

For j47 = m1 To m2                                            'a(47) = 3
If j47 = j48 Then GoTo 470
a(47) = j47
i = 47: GoSub 1880: If fl1 = 0 Then GoTo 470

a(39) = s1 / 2 - a(47) - a(55) - a(63):  If a(39) < m1 Or a(39) > m2 Then GoTo 470
i = 39: GoSub 1880: If fl1 = 0 Then GoTo 470
a(35) = -s1 / 4 + a(47) + a(55) + a(63): If a(35) < m1 Or a(35) > m2 Then GoTo 470

For j46 = m1 To m2                                            'a(46) = 5
If j46 = j47 Or j46 = j48 Then GoTo 460
a(46) = j46
i = 46: GoSub 1870: If fl1 = 0 Then GoTo 460

a(45) = s1 - a(46) - a(47) - a(48) - a(53) - a(54) - a(55) - a(56)
If a(45) < m1 Or a(45) > m2 Then GoTo 460
i = 45: GoSub 1870: If fl1 = 0 Then GoTo 460

a(38) = s1 / 2 - a(46) - a(54) - a(62):  If a(38) < m1 Or a(38) > m2 Then GoTo 460
i = 38: GoSub 1870: If fl1 = 0 Then GoTo 460
a(34) = -s1 / 4 + a(46) + a(54) + a(62): If a(34) < m1 Or a(34) > m2 Then GoTo 460
a(37) = s1 / 2 - a(45) - a(53) - a(61):  If a(37) < m1 Or a(37) > m2 Then GoTo 460
i = 37: GoSub 1870: If fl1 = 0 Then GoTo 460
a(33) = -s1 / 4 + a(45) + a(53) + a(61): If a(33) < m1 Or a(33) > m2 Then GoTo 460

a(60) = s1 / 4 - a(64): a(59) = s1 / 4 - a(63): a(58) = s1 / 4 - a(62): a(57) = s1 / 4 - a(61)
a(52) = s1 / 4 - a(56): a(51) = s1 / 4 - a(55): a(50) = s1 / 4 - a(54): a(49) = s1 / 4 - a(53)
a(44) = s1 / 4 - a(48): a(43) = s1 / 4 - a(47): a(42) = s1 / 4 - a(46): a(41) = s1 / 4 - a(45)

a(1) = a(33): a(2) = a(34): a(3) = a(35): a(4) = a(36): a(5) = a(37): a(6) = a(38): a(7) = a(39):
a(8) = a(40): a(9) = a(41): a(10) = a(42): a(11) = a(43): a(12) = a(44): a(13) = a(45): a(14) = a(46):
a(15) = a(47): a(16) = a(48): a(17) = a(49): a(18) = a(50): a(19) = a(51): a(20) = a(52): a(21) = a(53):
a(22) = a(54): a(23) = a(55): a(24) = a(56): a(25) = a(57): a(26) = a(58): a(27) = a(59): a(28) = a(60):
a(29) = a(61): a(30) = a(62): a(31) = a(63): a(32) = a(64):

'                          Exclude solutions with identical numbers in:

GoSub 1800: If fl1 = 0 Then GoTo 460

n9 = n9 + 1
GoSub 2650      'Print results (squares)
'                          GoSub 2645      'Print results (selected numbers)

460 Next j46
470 Next j47
480 Next j48

540 Next j54

610 Next j61
620 Next j62

550 Next j55
560 Next j56

630 Next j63
640 Next j64

t2 = Timer

t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine Sudoku8c")

End

'                          Exclude solutions with identical numbers in:

1800

'    Rows

i1 = -7
For i0 = 1 To 8
i1 = i1 + 8
b(1) = a(i1):     b(2) = a(i1 + 1): b(3) = a(i1 + 2): b(4) = a(i1 + 3):
b(5) = a(i1 + 4): b(6) = a(i1 + 5): b(7) = a(i1 + 6): b(8) = a(i1 + 7)
GoSub 1860: If fl1 = 0 Then Return
Next i0

'    Main Diagonals

b(1) = a(1): b(2) = a(10): b(3) = a(19): b(4) = a(28): b(5) = a(37): b(6) = a(46): b(7) = a(55): b(8) = a(64)
GoSub 1860: If fl1 = 0 Then Return
b(1) = a(8): b(2) = a(15): b(3) = a(22): b(4) = a(29): b(5) = a(36): b(6) = a(43): b(7) = a(50): b(8) = a(57)
GoSub 1860: If fl1 = 0 Then Return

Return

'    Check identical numbers

1860 fl1 = 1
For j10 = 1 To 8
b2 = b(j10)
For j20 = (1 + j10) To 8
If b2 = b(j20) Then fl1 = 0: Return
Next j20
Next j10
Return

'    Check Pattern (2 x 2), Option 1

1870 fl1 = 1
If a(i) <> a(64) And a(i) <> a(63) And a(i) <> a(56) And a(i) <> a(55) Then fl1 = 0: Return
Return

'    Check Pattern (2 x 2), Option 2

1880 fl1 = 1
If a(i) <> a(62) And a(i) <> a(61) And a(i) <> a(54) And a(i) <> a(53) Then fl1 = 0: Return
Return

'    Print results (selected numbers)

2645 For i1 = 1 To 64
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 65).Select: Cells(n9, 65).Value = n9
Return

'    Print results (squares)

2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 9: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 9
End If

Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)

i3 = 0
For i1 = 1 To 8
For i2 = 1 To 8
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1

Return

End Sub
```