' Generates Pan Diagonal Top Squares for Pan Diagonal/Triagonal Cubes of order 5 for integers 0 thru 4

' Tested with Office 2007 under Windows 7

```Sub SudCube5e1()

Dim a(125), a5(25), b(10)

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

n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 0: m2 = 4: s1 = 10

t1 = Timer

'    Generate Top Squares

For j125 = m1 To m2
a(125) = j125

Cells(n9 + 1, 125).Select
Cells(n9 + 1, 125).Value = j125

For j124 = m1 To m2
a(124) = j124

Cells(n9 + 1, 124).Select
Cells(n9 + 1, 124).Value = j124

For j123 = m1 To m2
a(123) = j123

Cells(n9 + 1, 123).Select
Cells(n9 + 1, 123).Value = j123

For j122 = m1 To m2
a(122) = j122

Cells(n9 + 1, 122).Select
Cells(n9 + 1, 122).Value = j122

For j121 = m1 To m2
a(121) = j121

Cells(n9 + 1, 121).Select
Cells(n9 + 1, 121).Value = j121

For j120 = m1 To m2
If j120 = j121 Or j120 = j124 Then GoTo 1200
a(120) = j120

Cells(n9 + 1, 120).Select
Cells(n9 + 1, 120).Value = j120

For j119 = m1 To m2
If j119 = j123 Or j119 = j125 Then GoTo 1190
a(119) = j119

Cells(n9 + 1, 119).Select
Cells(n9 + 1, 119).Value = j119

For j118 = m1 To m2
If j118 = j122 Or j118 = j124 Then GoTo 1180
a(118) = j118

Cells(n9 + 1, 118).Select
Cells(n9 + 1, 118).Value = j118

For j117 = m1 To m2
If j117 = j121 Or j117 = j123 Then GoTo 1170
a(117) = j117

Cells(n9 + 1, 117).Select
Cells(n9 + 1, 117).Value = j117

For j116 = m1 To m2
If j116 = j122 Or j116 = j125 Then GoTo 1160
a(116) = j116

Cells(n9 + 1, 116).Select
Cells(n9 + 1, 116).Value = j116

For j115 = m1 To m2
If j115 = j119 Or j115 = j123 Or j115 = j116 Or j115 = j122 Then GoTo 1150
a(115) = j115

For j114 = m1 To m2
If j114 = j118 Or j114 = j122 Or j114 = j120 Or j114 = j121 Then GoTo 1140
a(114) = j114

For j113 = m1 To m2
If j113 = j117 Or j113 = j121 Or j113 = j119 Or j113 = j125 Then GoTo 1130
a(113) = j113

For j112 = m1 To m2
If j112 = j116 Or j112 = j125 Or j112 = j118 Or j112 = j124 Then GoTo 1120
a(112) = j112

For j111 = m1 To m2
If j111 = j120 Or j111 = j124 Or j111 = j117 Or j111 = j123 Then GoTo 1110
a(111) = j111

For j110 = m1 To m2
If j110 = j114 Or j110 = j118 Or j110 = j122 Then GoTo 1100
If j110 = j111 Or j110 = j117 Or j110 = j123 Then GoTo 1100
a(110) = j110

Cells(n9 + 1, 110).Select
Cells(n9 + 1, 110).Value = j110

a(109) = a(110) + a(111) - a(113) + a(114) - a(115) - a(116) + a(118) - a(119) + a(120) + a(124) - a(125)
If a(109) < m1 Or a(109) > m2 Then GoTo 1100
a(108) = a(110) + a(111) - a(112) - a(116) + a(117) + a(123) - a(125)
If a(108) < m1 Or a(108) > m2 Then GoTo 1100
a(107) = a(110) - a(113) + a(114) + a(118) - a(119) + a(122) - a(125)
If a(107) < m1 Or a(107) > m2 Then GoTo 1100
a(106) = a(110) + a(111) - a(112) + a(114) - a(115) - a(116) + a(117) - a(119) + a(120) + a(121) - a(125)
If a(106) < m1 Or a(106) > m2 Then GoTo 1100
a(105) = s1 - a(110) - a(111) - a(114) + a(115) + a(116) - a(117) - a(118) + a(119) - a(120) - a(121) - a(124) + a(125)
If a(105) < m1 Or a(105) > m2 Then GoTo 1100
a(104) = s1 - a(110) - a(111) - a(117) - a(123)
If a(104) < m1 Or a(104) > m2 Then GoTo 1100
a(103) = s1 - a(110) - a(111) + a(113) - a(114) - a(118) + a(119) - a(120) - a(122) - a(124) + a(125)
If a(103) < m1 Or a(103) > m2 Then GoTo 1100
a(102) = s1 - a(110) - a(111) + a(112) - a(114) + a(116) - a(117) - a(120) - a(121) - a(123) + a(125)
If a(102) < m1 Or a(102) > m2 Then GoTo 1100
a(101) = s1 - a(110) - a(114) - a(118) - a(122)
If a(101) < m1 Or a(101) > m2 Then GoTo 1100

'   Exclude solutions with identical numbers in Pan Diagonals, Pan Triagonals (?)

GoSub 800: If fl1 = 0 Then GoTo 1100

n9 = n9 + 1

GoSub 1740 'Print results (selected numbers)

1100 Next j110

1110 Next j111
1120 Next j112
1130 Next j113
1140 Next j114
1150 Next j115

1160 Next j116
1170 Next j117
1180 Next j118
1190 Next j119
1200 Next j120

1210 Next j121
1220 Next j122
1230 Next j123
1240 Next j124
1250 Next j125

t2 = Timer

t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
y = MsgBox(t10, 0, "Routine SudCube5e2")

End

'    Check (Pan) Diagonals Top Square

800  fl1 = 1

For i1 = 1 To 25
a5(i1) = a(100 + i1)
Next i1

b(1) = a5(1): b(2) = a5(7):  b(3) = a5(13): b(4) = a5(19): b(5) = a5(25): GoSub 860: If fl1 = 0 Then Return
b(1) = a5(2): b(2) = a5(8):  b(3) = a5(14): b(4) = a5(20): b(5) = a5(21): GoSub 860: If fl1 = 0 Then Return
b(1) = a5(3): b(2) = a5(9):  b(3) = a5(15): b(4) = a5(16): b(5) = a5(22): GoSub 860: If fl1 = 0 Then Return
b(1) = a5(4): b(2) = a5(10): b(3) = a5(11): b(4) = a5(17): b(5) = a5(23): GoSub 860: If fl1 = 0 Then Return
b(1) = a5(5): b(2) = a5(6):  b(3) = a5(12): b(4) = a5(18): b(5) = a5(24): GoSub 860: If fl1 = 0 Then Return

b(1) = a5(5): b(2) = a5(9):  b(3) = a5(13): b(4) = a5(17): b(5) = a5(21): GoSub 860: If fl1 = 0 Then Return
b(1) = a5(4): b(2) = a5(8):  b(3) = a5(12): b(4) = a5(16): b(5) = a5(25): GoSub 860: If fl1 = 0 Then Return
b(1) = a5(3): b(2) = a5(7):  b(3) = a5(11): b(4) = a5(20): b(5) = a5(24): GoSub 860: If fl1 = 0 Then Return
b(1) = a5(2): b(2) = a5(6):  b(3) = a5(15): b(4) = a5(19): b(5) = a5(23): GoSub 860: If fl1 = 0 Then Return
b(1) = a5(1): b(2) = a5(10): b(3) = a5(14): b(4) = a5(18): b(5) = a5(22): GoSub 860: If fl1 = 0 Then Return

Return

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

'    Print results (selected numbers)

1740 For i1 = 101 To 125
Cells(n9, i1).Value = a(i1)
Next i1

Return

End Sub
```