' Associated Pandiagonal Magic Cubes (m = 15)

' Tested with Office 2007 under Windows 7

```Dim R35(3, 5)

Sub PanDia23()

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

' Magic Rectangle R35:

''R35(1, 1) = 14: R35(1, 2) = 10: R35(1, 3) = 4:  R35(1, 4) = 5:  R35(1, 5) = 7:
''R35(2, 1) = 1:  R35(2, 2) = 3:  R35(2, 3) = 8:  R35(2, 4) = 13: R35(2, 5) = 15:
''R35(3, 1) = 9:  R35(3, 2) = 11: R35(3, 3) = 12: R35(3, 4) = 6:  R35(3, 5) = 2:

' Read Rectangle R35 from Spreadsheet (line format)

j10 = 1                      'line number 1 ... 16
k1 = 1: k2 = 0
For j20 = 1 To 15

k2 = k2 + 1: If k2 = 6 Then k2 = 1: k1 = k1 + 1
R35(k1, k2) = Sheets("R35").Cells(j10, j20).Value

t10 = t10 + CStr(R35(k1, k2)) + ", "
Next j20

m = 15

n9 = 0: k1 = 0: k2 = 0
For i = 0 To m - 1
For j = 0 To m - 1
j1 = j1 + 1
For k = 0 To m - 1
k1 = k1 + 1: k2 = k2 + 1

b = i + 2 * j + 3 * k + ((m - 1) / 2 + 3)
c = i + 3 * j + 2 * k + ((m - 1) / 2 + 3)
d = 2 * i + 3 * j - k + ((m - 1) / 2 + 2)
If d < m Then d = d + m

b1 = b Mod m
c1 = c Mod m
d1 = d Mod m

a = S15(b1) * m ^ 2 + S15(c1) * m + S15(d1) + 1

'   Print Cube

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

'   Print Components

'    Cells(j1 + 1, k1 + 1 + m + 1).Value = b1
'    Cells(j1 + 1, k1 + 1 + 2 * (m + 1)).Value = c1
'    Cells(j1 + 1, k1 + 1 + 3 * (m + 1)).Value = d1

Next k
Next j
Next i

End Sub

Function S15(x)

x1 = x Mod 3
y1 = x Mod 5
S15 = R35(x1 + 1, y1 + 1) - 1

End Function
```