' Generates Quaternary Pandiagonal/Triagonal Cubes of order 4 for integers 0 thru 3
' Tested with Office 2007 under Windows 7
Sub SudCube4c()
Dim a(64), a5(16), b(4)
y = MsgBox("Locked", vbCritical, "Routine SudCube4c")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 0: m2 = 3: s1 = 6
Sheets("Test4").Select
t1 = Timer
' Generate Top Squares
For j64 = m1 To m2
a(64) = j64
For j63 = m1 To m2
a(63) = j63
For j62 = m1 To m2
a(62) = j62
For j61 = m1 To m2
a(61) = j61
For j60 = m1 To m2
a(60) = j60
For j59 = m1 To m2
a(59) = j59
For j58 = m1 To m2
a(58) = j58
For j57 = m1 To m2
a(57) = j57
For j56 = m1 To m2
a(56) = j56
For j55 = m1 To m2
a(55) = j55
a(54) = a(56) + a(62) - a(64)
If a(54) < m1 Or a(54) > m2 Then GoTo 550
a(53) = a(55) + a(61) - a(63)
If a(53) < m1 Or a(53) > m2 Then GoTo 550
a(52) = s1 - a(55) - a(58) - a(61)
If a(52) < m1 Or a(52) > m2 Then GoTo 550
a(51) = s1 - a(56) - a(57) - a(62)
If a(51) < m1 Or a(51) > m2 Then GoTo 550
a(50) = s1 - a(55) - a(60) - a(61)
If a(50) < m1 Or a(50) > m2 Then GoTo 550
a(49) = s1 - a(56) - a(59) - a(62)
If a(49) < m1 Or a(49) > m2 Then GoTo 550
For j48 = m1 To m2
a(48) = j48
For j47 = m1 To m2
a(47) = j47
a(46) = a(48) - a(58) + a(60): If a(46) < m1 Or a(46) > m2 Then GoTo 470
a(45) = a(47) - a(57) + a(59): If a(45) < m1 Or a(45) > m2 Then GoTo 470
a(44) = s1 - a(47) - a(59) - a(64): If a(44) < m1 Or a(44) > m2 Then GoTo 470
a(43) = s1 - a(48) - a(60) - a(63): If a(43) < m1 Or a(43) > m2 Then GoTo 470
a(42) = s1 - a(47) - a(59) - a(62): If a(42) < m1 Or a(42) > m2 Then GoTo 470
a(41) = s1 - a(48) - a(60) - a(61): If a(41) < m1 Or a(41) > m2 Then GoTo 470
a(40) = a(48) - a(55) + a(63): If a(40) < m1 Or a(40) > m2 Then GoTo 470
a(39) = a(47) - a(56) + a(64): If a(39) < m1 Or a(39) > m2 Then GoTo 470
a(38) = a(48) - a(55) - a(58) + a(60) + a(63): If a(38) < m1 Or a(38) > m2 Then GoTo 470
a(37) = a(47) - a(56) - a(57) + a(59) + a(64): If a(37) < m1 Or a(37) > m2 Then GoTo 470
a(36) = -a(47) + a(56) + a(57) + a(62) - a(64): If a(36) < m1 Or a(36) > m2 Then GoTo 470
a(35) = -a(48) + a(55) + a(58) + a(61) - a(63): If a(35) < m1 Or a(35) > m2 Then GoTo 470
a(34) = -a(47) + a(56) + a(57): If a(34) < m1 Or a(34) > m2 Then GoTo 470
a(33) = -a(48) + a(55) + a(58): If a(33) < m1 Or a(33) > m2 Then GoTo 470
a(32) = 0.5 * s1 - a(56) - a(62) + a(64): If a(32) < m1 Or a(32) > m2 Then GoTo 470
a(31) = 0.5 * s1 - a(55) - a(61) + a(63): If a(31) < m1 Or a(31) > m2 Then GoTo 470
a(30) = 0.5 * s1 - a(56): If a(30) < m1 Or a(30) > m2 Then GoTo 470
a(29) = 0.5 * s1 - a(55): If a(29) < m1 Or a(29) > m2 Then GoTo 470
a(28) = -0.5 * s1 + a(55) + a(60) + a(61): If a(28) < m1 Or a(28) > m2 Then GoTo 470
a(27) = -0.5 * s1 + a(56) + a(59) + a(62): If a(27) < m1 Or a(27) > m2 Then GoTo 470
a(26) = -0.5 * s1 + a(55) + a(58) + a(61): If a(26) < m1 Or a(26) > m2 Then GoTo 470
a(25) = -0.5 * s1 + a(56) + a(57) + a(62): If a(25) < m1 Or a(25) > m2 Then GoTo 470
a(24) = 0.5 * s1 - a(62): If a(24) < m1 Or a(24) > m2 Then GoTo 470
a(23) = 0.5 * s1 - a(61): If a(23) < m1 Or a(23) > m2 Then GoTo 470
a(22) = 0.5 * s1 - a(64): If a(22) < m1 Or a(22) > m2 Then GoTo 470
a(21) = 0.5 * s1 - a(63): If a(21) < m1 Or a(21) > m2 Then GoTo 470
a(20) = 0.5 * s1 - a(58): If a(20) < m1 Or a(20) > m2 Then GoTo 470
a(19) = 0.5 * s1 - a(57): If a(19) < m1 Or a(19) > m2 Then GoTo 470
a(18) = 0.5 * s1 - a(60): If a(18) < m1 Or a(18) > m2 Then GoTo 470
a(17) = 0.5 * s1 - a(59): If a(17) < m1 Or a(17) > m2 Then GoTo 470
a(16) = 0.5 * s1 - a(48) + a(55) + a(58) - a(60) - a(63): If a(16) < m1 Or a(16) > m2 Then GoTo 470
a(15) = 0.5 * s1 - a(47) + a(56) + a(57) - a(59) - a(64): If a(15) < m1 Or a(15) > m2 Then GoTo 470
a(14) = 0.5 * s1 - a(48) + a(55) - a(63): If a(14) < m1 Or a(14) > m2 Then GoTo 470
a(13) = 0.5 * s1 - a(47) + a(56) - a(64): If a(13) < m1 Or a(13) > m2 Then GoTo 470
a(12) = 0.5 * s1 + a(47) - a(56) - a(57): If a(12) < m1 Or a(12) > m2 Then GoTo 470
a(11) = 0.5 * s1 + a(48) - a(55) - a(58): If a(11) < m1 Or a(11) > m2 Then GoTo 470
a(10) = 0.5 * s1 + a(47) - a(56) - a(57) - a(62) + a(64): If a(10) < m1 Or a(10) > m2 Then GoTo 470
a(9) = 0.5 * s1 + a(48) - a(55) - a(58) - a(61) + a(63): If a(9) < m1 Or a(9) > m2 Then GoTo 470
a(8) = 0.5 * s1 - a(48) + a(58) - a(60): If a(8) < m1 Or a(8) > m2 Then GoTo 470
a(7) = 0.5 * s1 - a(47) + a(57) - a(59): If a(7) < m1 Or a(7) > m2 Then GoTo 470
a(6) = 0.5 * s1 - a(48): If a(6) < m1 Or a(6) > m2 Then GoTo 470
a(5) = 0.5 * s1 - a(47): If a(5) < m1 Or a(5) > m2 Then GoTo 470
a(4) = -0.5 * s1 + a(47) + a(59) + a(62): If a(4) < m1 Or a(4) > m2 Then GoTo 470
a(3) = -0.5 * s1 + a(48) + a(60) + a(61): If a(3) < m1 Or a(3) > m2 Then GoTo 470
a(2) = -0.5 * s1 + a(47) + a(59) + a(64): If a(2) < m1 Or a(2) > m2 Then GoTo 470
a(1) = -0.5 * s1 + a(48) + a(60) + a(63): If a(1) < m1 Or a(1) > m2 Then GoTo 470
' Exclude solutions with identical numbers in Pan Triagonals
GoSub 800: If fl1 = 0 Then GoTo 470
n9 = n9 + 1: GoSub 1740 'Print results (selected numbers)
' n9 = n9 + 1: GoSub 1750 'Print results (planes 11, 12, 13, 14)
' n9 = n9 + 1: GoSub 1760 'Print results (3d)
470 Next j47
480 Next j48
550 Next j55
560 Next j56
570 Next j57
580 Next j58
590 Next j59
600 Next j60
610 Next j61
620 Next j62
630 Next j63
640 Next j64
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
y = MsgBox(t10, 0, "Routine SudCube4c")
End
' Check Pan Triagonals
800 fl1 = 1
b(1) = a(49): b(2) = a(38): b(3) = a(27): b(4) = a(16): GoSub 860: If fl1 = 0 Then Return
b(1) = a(53): b(2) = a(42): b(3) = a(31): b(4) = a(4): GoSub 860: If fl1 = 0 Then Return
b(1) = a(57): b(2) = a(46): b(3) = a(19): b(4) = a(8): GoSub 860: If fl1 = 0 Then Return
b(1) = a(61): b(2) = a(34): b(3) = a(23): b(4) = a(12): GoSub 860: If fl1 = 0 Then Return
b(1) = a(50): b(2) = a(39): b(3) = a(28): b(4) = a(13): GoSub 860: If fl1 = 0 Then Return
b(1) = a(54): b(2) = a(43): b(3) = a(32): b(4) = a(1): GoSub 860: If fl1 = 0 Then Return
b(1) = a(58): b(2) = a(47): b(3) = a(20): b(4) = a(5): GoSub 860: If fl1 = 0 Then Return
b(1) = a(62): b(2) = a(35): b(3) = a(24): b(4) = a(9): GoSub 860: If fl1 = 0 Then Return
b(1) = a(51): b(2) = a(40): b(3) = a(25): b(4) = a(14): GoSub 860: If fl1 = 0 Then Return
b(1) = a(55): b(2) = a(44): b(3) = a(29): b(4) = a(2): GoSub 860: If fl1 = 0 Then Return
b(1) = a(59): b(2) = a(48): b(3) = a(17): b(4) = a(6): GoSub 860: If fl1 = 0 Then Return
b(1) = a(63): b(2) = a(36): b(3) = a(21): b(4) = a(10): GoSub 860: If fl1 = 0 Then Return
b(1) = a(52): b(2) = a(37): b(3) = a(26): b(4) = a(15): GoSub 860: If fl1 = 0 Then Return
b(1) = a(56): b(2) = a(41): b(3) = a(30): b(4) = a(3): GoSub 860: If fl1 = 0 Then Return
b(1) = a(60): b(2) = a(45): b(3) = a(18): b(4) = a(7): GoSub 860: If fl1 = 0 Then Return
b(1) = a(64): b(2) = a(33): b(3) = a(22): b(4) = a(11): GoSub 860: If fl1 = 0 Then Return
b(1) = a(52): b(2) = a(39): b(3) = a(26): b(4) = a(13): GoSub 860: If fl1 = 0 Then Return
b(1) = a(56): b(2) = a(43): b(3) = a(30): b(4) = a(1): GoSub 860: If fl1 = 0 Then Return
b(1) = a(60): b(2) = a(47): b(3) = a(18): b(4) = a(5): GoSub 860: If fl1 = 0 Then Return
b(1) = a(64): b(2) = a(35): b(3) = a(22): b(4) = a(9): GoSub 860: If fl1 = 0 Then Return
b(1) = a(49): b(2) = a(40): b(3) = a(27): b(4) = a(14): GoSub 860: If fl1 = 0 Then Return
b(1) = a(53): b(2) = a(44): b(3) = a(31): b(4) = a(2): GoSub 860: If fl1 = 0 Then Return
b(1) = a(57): b(2) = a(48): b(3) = a(19): b(4) = a(6): GoSub 860: If fl1 = 0 Then Return
b(1) = a(61): b(2) = a(36): b(3) = a(23): b(4) = a(10): GoSub 860: If fl1 = 0 Then Return
b(1) = a(50): b(2) = a(37): b(3) = a(28): b(4) = a(15): GoSub 860: If fl1 = 0 Then Return
b(1) = a(54): b(2) = a(41): b(3) = a(32): b(4) = a(3): GoSub 860: If fl1 = 0 Then Return
b(1) = a(58): b(2) = a(45): b(3) = a(20): b(4) = a(7): GoSub 860: If fl1 = 0 Then Return
b(1) = a(62): b(2) = a(33): b(3) = a(24): b(4) = a(11): GoSub 860: If fl1 = 0 Then Return
b(1) = a(51): b(2) = a(38): b(3) = a(25): b(4) = a(16): GoSub 860: If fl1 = 0 Then Return
b(1) = a(55): b(2) = a(42): b(3) = a(29): b(4) = a(4): GoSub 860: If fl1 = 0 Then Return
b(1) = a(59): b(2) = a(46): b(3) = a(17): b(4) = a(8): GoSub 860: If fl1 = 0 Then Return
b(1) = a(63): b(2) = a(34): b(3) = a(21): b(4) = a(12): GoSub 860: If fl1 = 0 Then Return
b(1) = a(61): b(2) = a(42): b(3) = a(23): b(4) = a(4): GoSub 860: If fl1 = 0 Then Return
b(1) = a(49): b(2) = a(46): b(3) = a(27): b(4) = a(8): GoSub 860: If fl1 = 0 Then Return
b(1) = a(53): b(2) = a(34): b(3) = a(31): b(4) = a(12): GoSub 860: If fl1 = 0 Then Return
b(1) = a(57): b(2) = a(38): b(3) = a(19): b(4) = a(16): GoSub 860: If fl1 = 0 Then Return
b(1) = a(62): b(2) = a(43): b(3) = a(24): b(4) = a(1): GoSub 860: If fl1 = 0 Then Return
b(1) = a(50): b(2) = a(47): b(3) = a(28): b(4) = a(5): GoSub 860: If fl1 = 0 Then Return
b(1) = a(54): b(2) = a(35): b(3) = a(32): b(4) = a(9): GoSub 860: If fl1 = 0 Then Return
b(1) = a(58): b(2) = a(39): b(3) = a(20): b(4) = a(13): GoSub 860: If fl1 = 0 Then Return
b(1) = a(63): b(2) = a(44): b(3) = a(21): b(4) = a(2): GoSub 860: If fl1 = 0 Then Return
b(1) = a(51): b(2) = a(48): b(3) = a(25): b(4) = a(6): GoSub 860: If fl1 = 0 Then Return
b(1) = a(55): b(2) = a(36): b(3) = a(29): b(4) = a(10): GoSub 860: If fl1 = 0 Then Return
b(1) = a(59): b(2) = a(40): b(3) = a(17): b(4) = a(14): GoSub 860: If fl1 = 0 Then Return
b(1) = a(64): b(2) = a(41): b(3) = a(22): b(4) = a(3): GoSub 860: If fl1 = 0 Then Return
b(1) = a(52): b(2) = a(45): b(3) = a(26): b(4) = a(7): GoSub 860: If fl1 = 0 Then Return
b(1) = a(56): b(2) = a(33): b(3) = a(30): b(4) = a(11): GoSub 860: If fl1 = 0 Then Return
b(1) = a(60): b(2) = a(37): b(3) = a(18): b(4) = a(15): GoSub 860: If fl1 = 0 Then Return
b(1) = a(64): b(2) = a(43): b(3) = a(22): b(4) = a(1): GoSub 860: If fl1 = 0 Then Return
b(1) = a(52): b(2) = a(47): b(3) = a(26): b(4) = a(5): GoSub 860: If fl1 = 0 Then Return
b(1) = a(56): b(2) = a(35): b(3) = a(30): b(4) = a(9): GoSub 860: If fl1 = 0 Then Return
b(1) = a(60): b(2) = a(39): b(3) = a(18): b(4) = a(13): GoSub 860: If fl1 = 0 Then Return
b(1) = a(61): b(2) = a(44): b(3) = a(23): b(4) = a(2): GoSub 860: If fl1 = 0 Then Return
b(1) = a(49): b(2) = a(48): b(3) = a(27): b(4) = a(6): GoSub 860: If fl1 = 0 Then Return
b(1) = a(53): b(2) = a(36): b(3) = a(31): b(4) = a(10): GoSub 860: If fl1 = 0 Then Return
b(1) = a(57): b(2) = a(40): b(3) = a(19): b(4) = a(14): GoSub 860: If fl1 = 0 Then Return
b(1) = a(62): b(2) = a(41): b(3) = a(24): b(4) = a(3): GoSub 860: If fl1 = 0 Then Return
b(1) = a(50): b(2) = a(45): b(3) = a(28): b(4) = a(7): GoSub 860: If fl1 = 0 Then Return
b(1) = a(54): b(2) = a(33): b(3) = a(32): b(4) = a(11): GoSub 860: If fl1 = 0 Then Return
b(1) = a(58): b(2) = a(37): b(3) = a(20): b(4) = a(15): GoSub 860: If fl1 = 0 Then Return
b(1) = a(63): b(2) = a(42): b(3) = a(21): b(4) = a(4): GoSub 860: If fl1 = 0 Then Return
b(1) = a(51): b(2) = a(46): b(3) = a(25): b(4) = a(8): GoSub 860: If fl1 = 0 Then Return
b(1) = a(55): b(2) = a(34): b(3) = a(29): b(4) = a(12): GoSub 860: If fl1 = 0 Then Return
b(1) = a(59): b(2) = a(38): b(3) = a(17): b(4) = a(16): GoSub 860: If fl1 = 0 Then Return
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
' Print results (selected numbers)
1740 Cells(n9, 64).Select
For i1 = 1 To 64
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (planes 11, 12, 13 and 14)
1750 n2 = n2 + 1
If n2 = 7 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
If i0 = 1 Then
Cells(k1 + (i0 - 1) * 5, k2 + 1).Value = "Plane 1" + CStr(i0) + " (C" + CStr(n9) + ")"
Else
Cells(k1 + (i0 - 1) * 5, k2 + 1).Value = "Plane 1" + CStr(i0)
End If
Next i0
Return
' Print results (3d)
1760 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
