' Associated Pantriagonal Magic Cubes (m >= 6)

' Tested with Office 2007 under Windows 7

```Sub AssPntr6()

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

m = 6

For k = 0 To m - 1

If Int(k / 2) = k / 2 Then    'k is even
k1 = k / 2
Else                          'k is odd
k1 = (m - 1 - k) / 2
End If

For i = 0 To m - 1
i11 = i11 + 1

If Int(i / 2) = i / 2 Then    'i is even
i1 = i / 2
Else                          'i is odd
i1 = (m - 1 - i) / 2
End If

For j = 0 To m - 1
j11 = j11 + 1: j12 = j12 + 1

If Int(j / 2) = j / 2 Then    'j is even
j1 = j / 2
Else                          'j is odd
j1 = (m - 1 - j) / 2
End If

'   t1 = (i1 + j1 - 2 * k1) Mod (m / 2)
'   t2 = (-i1 - j1 + 2 * k1) Mod (m / 2)

'   replaced modulo operator by:
'   n MOD d = n - d * INT(n / d)

t1 = (i1 + j1 - 2 * k1) - (m / 2) * Int((i1 + j1 - 2 * k1) / (m / 2))
t2 = (-i1 - j1 + 2 * k1) - (m / 2) * Int((-i1 - j1 + 2 * k1) / (m / 2))

If t1 < t2 Then t = t1 Else t = t2

v0 = 4 * (k Mod 2) + 2 * (j Mod 2) + ((i + j + k) Mod 2)

If Int(v0 / 2) = v0 / 2 Then  'v0 is even
v1 = 7 - v0 / 2
Else                          'v0 is odd
v1 = 3 - (v0 - 1) / 2
End If

If Int((i + j + k) / 2) = (i + j + k) / 2 Then                   '(i+j+k) is even
c1 = k1 * (m / 2) ^ 2 + i1 * (m / 2) + j1
Else                                                             '(i+j+k) is odd
c1 = (m / 2) ^ 3 - 1 - (k1 * (m / 2) ^ 2 + i1 * (m / 2) + j1)
End If

If t = (m - 2) / 4 Then
b1 = v1
Else

If Int((t + (m - 2) / 4) / 2) = (t + (m - 2) / 4) / 2 Then  '(t + (m-2)/4) is even
b1 = 7 - v0
Else                                                        '(t + (m-2)/4) is odd
b1 = v0
End If

End If

a1 = b1 * (m / 2) ^ 3 + c1 + 1

'   Print Cube

If j11 = m + 1 Then j11 = 1
If j12 = m ^ 2 + 1 Then j12 = 1: i11 = i11 + 1
Cells(i11 + 1, j11 + 1).Value = a1

'   print Components

'   Cells(i11 + 1, j11 + 1 + 22).Value = b1
'   Cells(i11 + 1, j11 + 1 + 29).Value = c1

Next j
Next i
Next k

End Sub

```