' Combines 3th order Magic Cubes into 9th order Magic Cubes

' Tested with Office 2007 under Windows 7

```Sub CnstrCbs9()

Dim M(27), B(27, 27), C(9, 9, 9), nB(27)

'   M(j1)       = Multiplier Cube  j1 = element
'   B(j2,j1)    = Sub Cube         j2 = cube nr
'                                  j1 = element
'   C(j1,j2,j3) = Composed   Cube  j1 = row
'                                  j2 = column
'                                  j3 = layer
'   m1          = Selected   Cube  from Workheet "Cube3"
'   nB(27)      = Selected   Cubes from Workheet "Cube3"

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

'   m1 = 185 and nB(i) = 185 for i = 1 ... 27: Harvey Heinz's example

'   Initialise

m1 = 109
nB(1) = 91:  nB(2) = 1:   nB(3) = 82:   nB(4) = 56:   nB(5) = 145:  nB(6) = 172:  nB(7) = 158:  nB(8) = 34:   nB(9) = 21:
nB(10) = 2:  nB(11) = 30: nB(12) = 73:  nB(13) = 37:  nB(14) = 189: nB(15) = 168: nB(16) = 112: nB(17) = 141: nB(18) = 28:
nB(19) = 50: nB(20) = 6:  nB(21) = 159: nB(22) = 151: nB(23) = 152: nB(24) = 64:  nB(25) = 87:  nB(26) = 107: nB(27) = 155:

n2 = 0: n9 = 0: k1 = 1: k2 = 1

'   Load 3th order Magic Cubes

j10 = m1:                      GoSub 100    'Read Multiplier

For j1 = 1 To 27
j10 = nB(j1): j20 = j1:    GoSub 200    'Read Base Cubes
Next j1

GoSub 300                                   'Print Input (3 plane view)

'   Compose 9th order Magic Cube

Sheets("Constr9").Select
n9 = 1

i4 = 0: i1 = -2
For j1 = 1 To 3
i1 = i1 + 3

i2 = -2
For j2 = 1 To 3
i2 = i2 + 3

i3 = -2
For j3 = 1 To 3
i3 = i3 + 3

i4 = i4 + 1: GoSub 500              'Fill 9th order Magic Cube

Next j3
Next j2
Next j1

GoSub 800                                   'Print 9th order Magic Cube

End

'   Read 3th order Multiplier (line format)

100 For i1 = 1 To 27
M(i1) = Sheets("Cubes3").Cells(j10, i1).Value
Next i1
Return

'   Read 3th order Base Cubes (line format)

200 For i1 = 1 To 27
B(j20, i1) = Sheets("Cubes3").Cells(j10, i1).Value
Next i1
Return

'   Print Input (3 plane view)

300 Sheets("Input3").Select
n9 = 0
For j20 = 1 To 27
n9 = n9 + 1: GoSub 650     'Print Base Cubes
Next j20

n9 = 0: GoSub 700              'Print Multiplier

Return

'   Fill 9th order Magic Cube

500 i10 = i1 - 1: i20 = i2 - 1: i30 = i3 - 1: i40 = 0
For j10 = 1 To 3
i10 = i10 + 1
For j20 = 1 To 3
i20 = i20 + 1
For j30 = 1 To 3
i30 = i30 + 1

i40 = i40 + 1
C(i10, i20, i30) = B(i4, i40) + (M(i4) - 1) * 27

Next j30
i30 = i3 - 1
Next j20
i20 = i2 - 1
Next j10
Return

'   Print 3th order Magic Cubes (planes 1, 2 and 3)

650 n2 = n2 + 1
If n2 = 4 Then
n2 = 1: k1 = k1 + 12: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 4
End If

Cells(k1, k2 + 1).Value = "Base " + CStr(n9)

For i0 = 1 To 3
i3 = (i0 - 1) * 9
For i1 = 1 To 3
For i2 = 1 To 3
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 4, k2 + i2).Value = B(j20, i3)
Next i2
Next i1
Next i0

Return

700 n2 = 1: k1 = 1: k2 = 13

Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = "Multiplier"

For i0 = 1 To 3
i3 = (i0 - 1) * 9
For i1 = 1 To 3
For i2 = 1 To 3
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 4, k2 + i2).Value = M(i3)
Next i2
Next i1
Next i0

Return

'   Print 9th order Magic Cubes (planes 1, 2 ... 9)

800 n2 = 1: k1 = 1: k2 = 1

For i0 = 1 To 9
For i1 = 1 To 9
For i2 = 1 To 9
Cells(k1 + i1 + (i0 - 1) * 10, k2 + i2).Value = C(i0, i1, i2)
Next i2
Next i1
Next i0

Return

End Sub

'   Random Selection Sub Cubes (28 is Multiplier Cube)

Sub SlctCbs3()