' Generates Sudoku Comparable Cubes of order 4 for integers 0 thru 3

' Tested with Office 2007 under Windows 7

```Sub SudCube4()

Dim a(64), b(4)

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

n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 0: m2 = 3: s1 = 6

'   Generate data

t1 = Timer

For j64 = m1 To m2                                                   'a(64)
a(64) = j64
For j63 = m1 To m2                                                   'a(63)
a(63) = j63
For j62 = m1 To m2                                                   'a(62)
a(62) = j62

a(61) = s1 - a(62) - a(63) - a(64)
If a(61) < 0 Or a(61) > 3 Then GoTo 620                          'a(61)

For j60 = m1 To m2                                                   'a(60)
a(60) = j60
For j59 = m1 To m2                                                   'a(59)
a(59) = j59
For j58 = m1 To m2                                                   'a(58)
a(58) = j58

a(57) = s1 - a(58) - a(59) - a(60)
If a(57) < 0 Or a(57) > 3 Then GoTo 580                          'a(57)

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

a(55) = -s1 + a(56) - a(58) + a(60) + a(62) + a(63) + 2 * a(64)
If a(55) < 0 Or a(55) > 3 Then GoTo 560                          'a(55)

a(54) = s1 - a(55) - a(58) - a(59)
If a(54) < 0 Or a(54) > 3 Then GoTo 560                          'a(54)

a(53) = -a(56) + a(58) + a(59)
If a(53) < 0 Or a(53) > 3 Then GoTo 560                          'a(53)

a(52) = s1 - a(56) - a(60) - a(64)
If a(52) < 0 Or a(52) > 3 Then GoTo 560                          'a(52)

a(51) = s1 - a(55) - a(59) - a(63)
If a(51) < 0 Or a(51) > 3 Then GoTo 560                          'a(51)

a(50) = a(55) + a(59) - a(62)
If a(50) < 0 Or a(50) > 3 Then GoTo 560                          'a(50)

a(49) = a(55) + a(58) - a(64)
If a(49) < 0 Or a(49) > 3 Then GoTo 560                          'a(49)

For j48 = m1 To m2                                                   'a(48)
a(48) = j48
For j47 = m1 To m2                                                   'a(47)
a(47) = j47
For j46 = m1 To m2                                                   'a(46)
a(46) = j46

a(45) = s1 - a(46) - a(47) - a(48)
If a(45) < 0 Or a(45) > 3 Then GoTo 460                          'a(45)

For j44 = m1 To m2                                                   'a(44)
a(44) = j44

a(43) = s1 - a(44) - a(46) - a(48) - a(58) - a(60) + a(63) + a(64): If a(43) < 0 Or a(43) > 3 Then GoTo 440
a(42) = s1 - a(43) - a(62) - a(63): If a(42) < 0 Or a(42) > 3 Then GoTo 440
a(41) = -a(44) + a(62) + a(63): If a(41) < 0 Or a(41) > 3 Then GoTo 440
a(40) = s1 + a(42) - a(47) - a(48) - a(56) + a(58) - a(63) - a(64): If a(40) < 0 Or a(40) > 3 Then GoTo 440
a(39) = s1 - a(43) - a(56) - a(60): If a(39) < 0 Or a(39) > 3 Then GoTo 440
a(38) = -a(42) + a(56) + a(60): If a(38) < 0 Or a(38) > 3 Then GoTo 440
a(37) = s1 - a(40) - a(62) - a(63): If a(37) < 0 Or a(37) > 3 Then GoTo 440
a(36) = s1 - a(40) - a(44) - a(48): If a(36) < 0 Or a(36) > 3 Then GoTo 440
a(35) = -a(47) + a(56) + a(60): If a(35) < 0 Or a(35) > 3 Then GoTo 440
a(34) = s1 - a(46) - a(56) - a(60): If a(34) < 0 Or a(34) > 3 Then GoTo 440
a(33) = -a(36) + a(46) + a(47): If a(33) < 0 Or a(33) > 3 Then GoTo 440
a(32) = 1.5 * s1 + a(44) + 1.5 * a(46) - 0.5 * a(47) - a(56) + 1.5 * a(58) - 0.5 * a(59) - a(62) - 3 * a(63) - 3 * a(64)
If a(32) < 0 Or a(32) > 3 Then GoTo 440
If Int(a(32)) <> a(32) Then GoTo 440
a(31) = -s1 + a(32) - a(46) + a(48) + a(62) + a(63) + 2 * a(64): If a(31) < 0 Or a(31) > 3 Then GoTo 440
a(30) = s1 - a(31) - a(46) - a(47): If a(30) < 0 Or a(30) > 3 Then GoTo 440
a(29) = -a(32) + a(46) + a(47): If a(29) < 0 Or a(29) > 3 Then GoTo 440
a(28) = -a(30) - a(44) - a(46) + 2 * a(56) - 2 * a(58) + 2 * a(63) + 2 * a(64)
If a(28) < 0 Or a(28) > 3 Then GoTo 440
a(27) = -a(32) + a(44) + a(46) + a(58) + a(60) - a(63) - a(64): If a(27) < 0 Or a(27) > 3 Then GoTo 440
a(26) = -a(27) + a(62) + a(63): If a(26) < 0 Or a(26) > 3 Then GoTo 440
a(25) = -a(27) - a(46) - a(48) + a(59) + a(60) + a(63) + a(64): If a(25) < 0 Or a(25) > 3 Then GoTo 440
a(24) = 2 * s1 - a(32) - a(44) - a(48) - a(56) - a(60) - 2 * a(64): If a(24) < 0 Or a(24) > 3 Then GoTo 440
a(23) = -a(27) + a(56) + a(60): If a(23) < 0 Or a(23) > 3 Then GoTo 440
a(22) = s1 - a(23) - a(62) - a(63): If a(22) < 0 Or a(22) > 3 Then GoTo 440
a(21) = -a(24) + a(62) + a(63): If a(21) < 0 Or a(21) > 3 Then GoTo 440
a(20) = s1 - a(25) + a(44) - a(46) - a(47) - a(48) - a(56) + a(58) + a(59) + a(60) - a(62) - a(63)
If a(20) < 0 Or a(20) > 3 Then GoTo 440
a(19) = -a(21) + a(44) + a(46): If a(19) < 0 Or a(19) > 3 Then GoTo 440
a(18) = a(21) - a(44) + a(47): If a(18) < 0 Or a(18) > 3 Then GoTo 440
a(17) = s1 - a(20) - a(46) - a(47): If a(17) < 0 Or a(17) > 3 Then GoTo 440
a(16) = -s1 - a(18) + a(47) + a(56) + a(60) + a(62) + a(63) + a(64): If a(16) < 0 Or a(16) > 3 Then GoTo 440
a(15) = a(19) - a(47) + a(56) + a(60) - a(63): If a(15) < 0 Or a(15) > 3 Then GoTo 440
a(14) = s1 - a(15) - a(62) - a(63): If a(14) < 0 Or a(14) > 3 Then GoTo 440
a(13) = -a(16) + a(62) + a(63): If a(13) < 0 Or a(13) > 3 Then GoTo 440
a(12) = 2 * s1 + a(20) - 2 * a(44) - a(48) - a(56) - 2 * a(60) - 2 * a(64): If a(12) < 0 Or a(12) > 3 Then GoTo 440
a(11) = s1 + a(13) - a(59) - a(62) - a(63) - a(64): If a(11) < 0 Or a(11) > 3 Then GoTo 440
a(10) = s1 - a(11) - a(58) - a(59): If a(10) < 0 Or a(10) > 3 Then GoTo 440
a(9) = -a(17) + a(48) + a(56): If a(9) < 0 Or a(9) > 3 Then GoTo 440
a(8) = s1 - a(12) - a(56) - a(60): If a(8) < 0 Or a(8) > 3 Then GoTo 440
a(7) = -a(8) - a(46) + a(47) - a(58) - a(60) + 2 * a(63) + 2 * a(64): If a(7) < 0 Or a(7) > 3 Then GoTo 440
a(6) = -2 * s1 + a(11) + a(56) + 2 * a(59) + a(60) + a(62) + a(63) + 2 * a(64): If a(6) < 0 Or a(6) > 3 Then GoTo 440
a(5) = 3 * s1 - a(12) - 2 * a(44) - a(46) - a(47) - 2 * a(48) - a(56) - a(60) - 2 * a(64)
If a(5) < 0 Or a(5) > 3 Then GoTo 440
a(4) = s1 + a(6) - a(59) - a(62) - a(63) - a(64): If a(4) < 0 Or a(4) > 3 Then GoTo 440
a(3) = -a(5) + a(60) + a(62): If a(3) < 0 Or a(3) > 3 Then GoTo 440
a(2) = -a(3) + a(62) + a(63): If a(2) < 0 Or a(2) > 3 Then GoTo 440
a(1) = s1 - a(4) - a(62) - a(63): If a(1) < 0 Or a(1) > 3 Then GoTo 440

'       Exclude solutions with identical numbers in rows, colums or pillars

GoSub 800: If fl1 = 0 Then GoTo 440

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)

440 Next j44

460 Next j46
Next j47
Next j48

560 Next j56

580 Next j58
Next j59
Next j60

620 Next j62
Next j63
Next j64

t2 = Timer

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

End

'   Print results (selected numbers)

740 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

'   Exclude solutions with identical numbers in rows, colums or pillars

800 fl1 = 1

'   Rows

i1 = -3
For i0 = 1 To 16
i1 = i1 + 4
b(1) = a(i1): b(2) = a(i1 + 1): b(3) = a(i1 + 2): b(4) = a(i1 + 3)
GoSub 860
If fl1 = 0 Then Return
Next i0

'   Columns

i1 = 0: i2 = 0
For i0 = 1 To 16
i1 = i1 + 1
b(1) = a(i1): b(2) = a(i1 + 4): b(3) = a(i1 + 8): b(4) = a(i1 + 12)
i2 = i2 + 1: If i2 = 4 Then i2 = 0: i1 = i1 + 12
GoSub 860
If fl1 = 0 Then Return
Next i0

'   Pillars

i1 = 0: i2 = 0
For i0 = 1 To 16
i1 = i0
b(1) = a(i1): b(2) = a(i1 + 16): b(3) = a(i1 + 32): b(4) = a(i1 + 48)
GoSub 860
If fl1 = 0 Then Return
Next i0

'   Space Diagonals

b(1) = a(1):  b(2) = a(22): b(3) = a(43): b(4) = a(64): GoSub 860: If fl1 = 0 Then Return
b(1) = a(4):  b(2) = a(23): b(3) = a(42): b(4) = a(61): GoSub 860: If fl1 = 0 Then Return
b(1) = a(13): b(2) = a(26): b(3) = a(39): b(4) = a(52): GoSub 860: If fl1 = 0 Then Return
b(1) = a(16): b(2) = a(27): b(3) = a(38): b(4) = a(49): GoSub 860: If fl1 = 0 Then Return

850 Return

860 fl1 = 1
For j1 = 1 To 4
b2 = b(j1)
For j2 = (1 + j1) To 4
If b2 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
Return

End Sub
```