' Combines Sudoku Comparable Cubes into Almost Perfect Magic Cubes

' Tested with Office 2007 under Windows 7

```Sub CnstrCbs4()

Dim b(3, 64), a(64), c(4), s2(4), s(12, 10)

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

n4 = 56                  'Sudoku41:  4
'Sudoku42: 56

n2 = 0: n9 = 0: k1 = 1: k2 = 1
s1 = 130

For j1 = 1 To n4

For j2 = 1 To n4
If j2 = j1 Then GoTo 20

For j3 = 1 To n4
If j3 = j1 Or j3 = j2 Then GoTo 30

j10 = j1: j20 = 1: GoSub 100                 'Read Sudoku Comparable Cube 1
j10 = j2: j20 = 2: GoSub 100                 'Read Sudoku Comparable Cube 2
j10 = j3: j20 = 3: GoSub 100                 'Read Sudoku Comparable Cube 3

For j4 = 1 To 64
a(j4) = b(1, j4) + 4 * b(2, j4) + 16 * b(3, j4) + 1
Next j4

GoSub 200: If fl1 = 0 Then GoTo 30           'Check Magic Sum
GoSub 300: If fl1 = 0 Then GoTo 30           'Ckeck identical numbers

n9 = n9 + 1: GoSub 740 'Print results (selected numbers)
'       n9 = n9 + 1: GoSub 750 'Print results (planes 1, 2, 3, 4)
'       n9 = n9 + 1: GoSub 760 'Print results (3d)

30  Next j3

20  Next j2

Next j1

End

100 i3 = 0
k11 = Int((j10 - 1) / 8)
k12 = j10 - k11 * 8

k21 = 2 + k11 * 20
k22 = 2 + (k12 - 1) * 5

For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1

b(j20, i3) = Sheets("Sudoku42").Cells(k21 - 1 + i1 + (i0 - 1) * 5, k22 - 1 + i2).Value  'load cube

Next i2
Next i1
Next i0

Return

'   Check Magic Sum

200 fl1 = 1

'   Plane 11 (Top)                            Plane 21 (Left)                           Plane 31 (Back)

s(1, 1) = a(49) + a(50) + a(51) + a(52):  s(5, 1) = a(61) + a(57) + a(53) + a(49):  s(9, 1) = a(49) + a(50) + a(51) + a(52)
s(1, 2) = a(53) + a(54) + a(55) + a(56):  s(5, 2) = a(45) + a(41) + a(37) + a(33):  s(9, 2) = a(33) + a(34) + a(35) + a(36)
s(1, 3) = a(57) + a(58) + a(59) + a(60):  s(5, 3) = a(29) + a(25) + a(21) + a(17):  s(9, 3) = a(17) + a(18) + a(19) + a(20)
s(1, 4) = a(61) + a(62) + a(63) + a(64):  s(5, 4) = a(13) + a(9) + a(5) + a(1):     s(9, 4) = a(1) + a(2) + a(3) + a(4)

s(1, 5) = a(49) + a(53) + a(57) + a(61):  s(5, 5) = a(61) + a(45) + a(29) + a(13):  s(9, 5) = a(49) + a(33) + a(17) + a(1)
s(1, 6) = a(50) + a(54) + a(58) + a(62):  s(5, 6) = a(57) + a(41) + a(25) + a(9):   s(9, 6) = a(50) + a(34) + a(18) + a(2)
s(1, 7) = a(51) + a(55) + a(59) + a(63):  s(5, 7) = a(53) + a(37) + a(21) + a(5):   s(9, 7) = a(51) + a(35) + a(19) + a(3)
s(1, 8) = a(52) + a(56) + a(60) + a(64):  s(5, 8) = a(49) + a(33) + a(17) + a(1):   s(9, 8) = a(52) + a(36) + a(20) + a(4)

s(1, 9) = a(49) + a(54) + a(59) + a(64):  s(5, 9) = a(61) + a(41) + a(21) + a(1):   s(9, 9) = a(49) + a(34) + a(19) + a(4)
s(1, 10) = a(52) + a(55) + a(58) + a(61): s(5, 10) = a(49) + a(37) + a(25) + a(13): s(9, 10) = a(52) + a(35) + a(18) + a(1)

'   Plane 12                                  Plane 22                                  Plane 32

s(2, 1) = a(33) + a(34) + a(35) + a(36):  s(6, 1) = a(62) + a(58) + a(54) + a(50):  s(10, 1) = a(53) + a(54) + a(55) + a(56)
s(2, 2) = a(37) + a(38) + a(39) + a(40):  s(6, 2) = a(46) + a(42) + a(38) + a(34):  s(10, 2) = a(37) + a(38) + a(39) + a(40)
s(2, 3) = a(41) + a(42) + a(43) + a(44):  s(6, 3) = a(30) + a(26) + a(22) + a(18):  s(10, 3) = a(21) + a(22) + a(23) + a(24)
s(2, 4) = a(45) + a(46) + a(47) + a(48):  s(6, 4) = a(14) + a(10) + a(6) + a(2):    s(10, 4) = a(5) + a(6) + a(7) + a(8)

s(2, 5) = a(33) + a(37) + a(41) + a(45):  s(6, 5) = a(62) + a(46) + a(30) + a(14):  s(10, 5) = a(53) + a(37) + a(21) + a(5)
s(2, 6) = a(34) + a(38) + a(42) + a(46):  s(6, 6) = a(58) + a(42) + a(26) + a(10):  s(10, 6) = a(54) + a(38) + a(22) + a(6)
s(2, 7) = a(35) + a(39) + a(43) + a(47):  s(6, 7) = a(54) + a(38) + a(22) + a(6):   s(10, 7) = a(55) + a(39) + a(23) + a(7)
s(2, 8) = a(36) + a(40) + a(44) + a(48):  s(6, 8) = a(50) + a(34) + a(18) + a(2):   s(10, 8) = a(56) + a(40) + a(24) + a(8)

s(2, 9) = a(33) + a(38) + a(43) + a(48):  s(6, 9) = a(62) + a(42) + a(22) + a(2):   s(10, 9) = a(53) + a(38) + a(23) + a(8)
s(2, 10) = a(36) + a(39) + a(42) + a(45): s(6, 10) = a(50) + a(38) + a(26) + a(14): s(10, 10) = a(56) + a(39) + a(22) + a(5)

'   Plane 13                                  Plane 23                                  Plane 33

s(3, 1) = a(17) + a(18) + a(19) + a(20):  s(7, 1) = a(63) + a(59) + a(55) + a(51):  s(11, 1) = a(57) + a(58) + a(59) + a(60)
s(3, 2) = a(21) + a(22) + a(23) + a(24):  s(7, 2) = a(47) + a(43) + a(39) + a(35):  s(11, 2) = a(41) + a(42) + a(43) + a(44)
s(3, 3) = a(25) + a(26) + a(27) + a(28):  s(7, 3) = a(31) + a(27) + a(23) + a(19):  s(11, 3) = a(25) + a(26) + a(27) + a(28)
s(3, 4) = a(29) + a(30) + a(31) + a(32):  s(7, 4) = a(15) + a(11) + a(7) + a(3):    s(11, 4) = a(9) + a(10) + a(11) + a(12)

s(3, 5) = a(17) + a(21) + a(25) + a(29):  s(7, 5) = a(63) + a(47) + a(31) + a(15):  s(11, 5) = a(57) + a(41) + a(25) + a(9)
s(3, 6) = a(18) + a(22) + a(26) + a(30):  s(7, 6) = a(59) + a(43) + a(27) + a(11):  s(11, 6) = a(58) + a(42) + a(26) + a(10)
s(3, 7) = a(19) + a(23) + a(27) + a(31):  s(7, 7) = a(55) + a(39) + a(23) + a(7):   s(11, 7) = a(59) + a(43) + a(27) + a(11)
s(3, 8) = a(20) + a(24) + a(28) + a(32):  s(7, 8) = a(51) + a(35) + a(19) + a(3):   s(11, 8) = a(60) + a(44) + a(28) + a(12)

s(3, 9) = a(17) + a(22) + a(27) + a(32):  s(7, 9) = a(63) + a(43) + a(23) + a(3):   s(11, 9) = a(57) + a(42) + a(27) + a(12)
s(3, 10) = a(20) + a(23) + a(26) + a(29): s(7, 10) = a(51) + a(39) + a(27) + a(15): s(11, 10) = a(60) + a(43) + a(26) + a(9)

'   Plane 14                                  Plane 24                                  Plane 34

s(4, 1) = a(1) + a(2) + a(3) + a(4):      s(8, 1) = a(64) + a(60) + a(56) + a(52):  s(12, 1) = a(61) + a(62) + a(63) + a(64)
s(4, 2) = a(5) + a(6) + a(7) + a(8):      s(8, 2) = a(48) + a(44) + a(40) + a(36):  s(12, 2) = a(45) + a(46) + a(47) + a(48)
s(4, 3) = a(9) + a(10) + a(11) + a(12):   s(8, 3) = a(32) + a(28) + a(24) + a(20):  s(12, 3) = a(29) + a(30) + a(31) + a(32)
s(4, 4) = a(13) + a(14) + a(15) + a(16):  s(8, 4) = a(16) + a(12) + a(8) + a(4):    s(12, 4) = a(13) + a(14) + a(15) + a(16)

s(4, 5) = a(1) + a(5) + a(9) + a(13):     s(8, 5) = a(64) + a(48) + a(32) + a(16):  s(12, 5) = a(61) + a(45) + a(29) + a(13)
s(4, 6) = a(2) + a(6) + a(10) + a(14):    s(8, 6) = a(60) + a(44) + a(28) + a(12):  s(12, 6) = a(62) + a(46) + a(30) + a(14)
s(4, 7) = a(3) + a(7) + a(11) + a(15):    s(8, 7) = a(56) + a(40) + a(24) + a(8):   s(12, 7) = a(63) + a(47) + a(31) + a(15)
s(4, 8) = a(4) + a(8) + a(12) + a(16):    s(8, 8) = a(52) + a(36) + a(20) + a(4):   s(12, 8) = a(64) + a(48) + a(32) + a(16)

s(4, 9) = a(1) + a(6) + a(11) + a(16):    s(8, 9) = a(64) + a(44) + a(24) + a(4):   s(12, 9) = a(61) + a(46) + a(31) + a(16)
s(4, 10) = a(4) + a(7) + a(10) + a(13):   s(8, 10) = a(52) + a(40) + a(28) + a(16): s(12, 10) = a(64) + a(47) + a(30) + a(13)

'   Space Diagonals

s2(1) = a(13) + a(26) + a(39) + a(52)
s2(2) = a(16) + a(27) + a(38) + a(49)
s2(3) = a(1) + a(22) + a(43) + a(64)
s2(4) = a(4) + a(23) + a(42) + a(61)

For i1 = 1 To 12
For i2 = 1 To 10
If s(i1, i2) <> s1 Then fl1 = 0: Return
Next i2
Next i1

For i1 = 1 To 4
''If s2(i1) <> s1 Then fl1 = 0: Return
Next i1

Return

'   Check identical numbers

300 fl1 = 1
For i1 = 1 To 64
a2 = a(i1)
For i2 = (1 + i1) To 64
If a2 = a(i2) Then fl1 = 0: Return
Next i2
Next i1
Return

'   Print results (selected numbers)

740 Cells(n9, 1).Select
For i1 = 1 To 64
Cells(n9, i1).Value = a(i1)
Next i1

Return

'   Print results (planes 11, 12, 13 and 14)

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

For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 5, k2 + i2).Value = a(i3)
Next i2
Next i1
Cells(k1 + (i0 - 1) * 5, k2 + 1).Value = "Plane 1" + CStr(i0)
Next i0

Return

'   Print results (3d)

760 n2 = n2 + 1
If n2 = 3 Then
n2 = 1: k1 = k1 + 29: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 17
End If

For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
Cells(k1 + 1 + (i1 - 1) * 2 + (i0 - 1) * 7, k2 + 7 + (i2 - 1) * 3 - (i1 - 1) * 2).Value = a(i3)
Next i2
Next i1
Next i0

Return
End Sub
```