' Non-associated Pantriagonal Magic Cubes, Complete (m = 6)

' Tested with Office 2007 under Windows 7

```Sub CnstrPntr6()

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

Dim F6(3, 4)

F6(1, 1) = 0:  F6(1, 2) = 1:  F6(1, 3) = 2:  F6(1, 4) = 3:
F6(2, 1) = 4:  F6(2, 2) = 5:  F6(2, 3) = 6:  F6(2, 4) = 7:
F6(3, 1) = 14: F6(3, 2) = 12: F6(3, 3) = 10: F6(3, 4) = 8:

m = 6

n9 = 0
For k = 0 To m - 1
For i = 0 To m - 1
i1 = i1 + 1
For j = 0 To m - 1
j1 = j1 + 1: j2 = j2 + 1

b = i + j + k
c = i - j + k
If c < 0 Then c = c + m
d = i + j - k
If d < 0 Then d = d + m

b1 = b Mod (m / 2)
c1 = c Mod (m / 2)
d1 = d Mod (m / 2)

If k < m / 2 Then
q1 = 2 * Int(2 * i / m) + Int(2 * j / m)
Else
q1 = m / 2 - 2 * Int(2 * i / m) - Int(2 * j / m)
End If

z1 = Int(2 * i / m) + Int(2 * j / m) + Int(2 * k / m)
a1 = F6(b1 + 1, q1 + 1) * (m / 2) ^ 2 + c1 * (m / 2) + d1 + 1
If Int(z1 / 2) = z1 / 2 Then 'z1 is even
a = a1
Else
a = m ^ 3 + 1 - a1
End If

'   Print Cube

If j1 = m + 1 Then j1 = 1
If j2 = m ^ 2 + 1 Then j2 = 1: i1 = i1 + 1
Cells(i1 + 1, j1 + 1).Value = a

'   print Components

'   Cells(i1 + 1, j1 + 1 + 9).Value = F6(b1 + 1, q1 + 1)
'   Cells(i1 + 1, j1 + 1 + 18).Value = b1
'   Cells(i1 + 1, j1 + 1 + 27).Value = q1

Next j
Next i
Next k

End Sub
```