' Constructs Four Way V type ZigZag Magic Squares (8 x 8)
' Tested with Office 2007 under Windows 7
Sub DblOrder8()
Dim a(16), s1(4), s2(4), s3(4), b(64), c(64)
y = MsgBox("Locked", vbCritical, "Routine DblOrder8")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
For j100 = 2 To 2 ''9 'Select 2 x 2 Sub Square s1
For i1 = 1 To 4:
s1(i1) = Sheets("Lines4").Cells(j100, 19 + i1).Value:
Next i1
s2(1) = s1(2): s2(2) = s1(1):
s2(3) = s1(4): s2(4) = s1(3):
For j200 = 2 To 4 'Select 4 x 4 Base Square A
For i1 = 1 To 16
a(i1) = Sheets("Lines4").Cells(j200, i1).Value
Next i1
' Determine Intermediate Square B
For i1 = 1 To 16
If a(i1) <= 8 Then
For i2 = 1 To 4: s3(i2) = s1(i2): Next i2
Else
For i2 = 1 To 4: s3(i2) = s2(i2): Next i2
End If
Select Case i1
Case 1
b(1) = s3(1): b(2) = s3(2):
b(9) = s3(3): b(10) = s3(4):
Case 2
b(3) = s3(1): b(4) = s3(2):
b(11) = s3(3): b(12) = s3(4):
Case 3
b(5) = s3(1): b(6) = s3(2):
b(13) = s3(3): b(14) = s3(4):
Case 4
b(7) = s3(1): b(8) = s3(2):
b(15) = s3(3): b(16) = s3(4):
Case 5
b(17) = s3(1): b(18) = s3(2):
b(25) = s3(3): b(26) = s3(4):
Case 6
b(19) = s3(1): b(20) = s3(2):
b(27) = s3(3): b(28) = s3(4):
Case 7
b(21) = s3(1): b(22) = s3(2):
b(29) = s3(3): b(30) = s3(4):
Case 8
b(23) = s3(1): b(24) = s3(2):
b(31) = s3(3): b(32) = s3(4):
Case 9
b(33) = s3(1): b(34) = s3(2):
b(41) = s3(3): b(42) = s3(4):
Case 10
b(35) = s3(1): b(36) = s3(2):
b(43) = s3(3): b(44) = s3(4):
Case 11
b(37) = s3(1): b(38) = s3(2):
b(45) = s3(3): b(46) = s3(4):
Case 12
b(39) = s3(1): b(40) = s3(2):
b(47) = s3(3): b(48) = s3(4):
Case 13
b(49) = s3(1): b(50) = s3(2):
b(57) = s3(3): b(58) = s3(4):
Case 14
b(51) = s3(1): b(52) = s3(2):
b(59) = s3(3): b(60) = s3(4):
Case 15
b(53) = s3(1): b(54) = s3(2):
b(61) = s3(3): b(62) = s3(4):
Case 16
b(55) = s3(1): b(56) = s3(2):
b(63) = s3(3): b(64) = s3(4):
End Select
Next i1
' Calculate Square C
For i1 = 1 To 16
Select Case i1
Case 1
c(1) = (a(1) - 1) * 4 + b(1): c(2) = (a(1) - 1) * 4 + b(2):
c(9) = (a(1) - 1) * 4 + b(9): c(10) = (a(1) - 1) * 4 + b(10):
Case 2
c(3) = (a(2) - 1) * 4 + b(3): c(4) = (a(2) - 1) * 4 + b(4):
c(11) = (a(2) - 1) * 4 + b(11): c(12) = (a(2) - 1) * 4 + b(12):
Case 3
c(5) = (a(3) - 1) * 4 + b(5): c(6) = (a(3) - 1) * 4 + b(6):
c(13) = (a(3) - 1) * 4 + b(13): c(14) = (a(3) - 1) * 4 + b(14):
Case 4
c(7) = (a(4) - 1) * 4 + b(7): c(8) = (a(4) - 1) * 4 + b(8):
c(15) = (a(4) - 1) * 4 + b(15): c(16) = (a(4) - 1) * 4 + b(16):
Case 5
c(17) = (a(5) - 1) * 4 + b(17): c(18) = (a(5) - 1) * 4 + b(18):
c(25) = (a(5) - 1) * 4 + b(25): c(26) = (a(5) - 1) * 4 + b(26):
Case 6
c(19) = (a(6) - 1) * 4 + b(19): c(20) = (a(6) - 1) * 4 + b(20):
c(27) = (a(6) - 1) * 4 + b(27): c(28) = (a(6) - 1) * 4 + b(28):
Case 7
c(21) = (a(7) - 1) * 4 + b(21): c(22) = (a(7) - 1) * 4 + b(22):
c(29) = (a(7) - 1) * 4 + b(29): c(30) = (a(7) - 1) * 4 + b(30):
Case 8
c(23) = (a(8) - 1) * 4 + b(23): c(24) = (a(8) - 1) * 4 + b(24):
c(31) = (a(8) - 1) * 4 + b(31): c(32) = (a(8) - 1) * 4 + b(32):
Case 9
c(33) = (a(9) - 1) * 4 + b(33): c(34) = (a(9) - 1) * 4 + b(34):
c(41) = (a(9) - 1) * 4 + b(41): c(42) = (a(9) - 1) * 4 + b(42):
Case 10
c(35) = (a(10) - 1) * 4 + b(35): c(36) = (a(10) - 1) * 4 + b(36):
c(43) = (a(10) - 1) * 4 + b(43): c(44) = (a(10) - 1) * 4 + b(44):
Case 11
c(37) = (a(11) - 1) * 4 + b(37): c(38) = (a(11) - 1) * 4 + b(38):
c(45) = (a(11) - 1) * 4 + b(45): c(46) = (a(11) - 1) * 4 + b(46):
Case 12
c(39) = (a(12) - 1) * 4 + b(39): c(40) = (a(12) - 1) * 4 + b(40):
c(47) = (a(12) - 1) * 4 + b(47): c(48) = (a(12) - 1) * 4 + b(48):
Case 13
c(49) = (a(13) - 1) * 4 + b(49): c(50) = (a(13) - 1) * 4 + b(50):
c(57) = (a(13) - 1) * 4 + b(57): c(58) = (a(13) - 1) * 4 + b(58):
Case 14
c(51) = (a(14) - 1) * 4 + b(51): c(52) = (a(14) - 1) * 4 + b(52):
c(59) = (a(14) - 1) * 4 + b(59): c(60) = (a(14) - 1) * 4 + b(60):
Case 15
c(53) = (a(15) - 1) * 4 + b(53): c(54) = (a(15) - 1) * 4 + b(54):
c(61) = (a(15) - 1) * 4 + b(61): c(62) = (a(15) - 1) * 4 + b(62):
Case 16
c(55) = (a(16) - 1) * 4 + b(55): c(56) = (a(16) - 1) * 4 + b(56):
c(63) = (a(16) - 1) * 4 + b(63): c(64) = (a(16) - 1) * 4 + b(64):
End Select
Next i1
' n9 = n9 + 1: GoSub 645 ' Print results (selected numbers)
n9 = n9 + 1: GoSub 650 ' Print results (squares)
200 Next j200
100 Next j100
End
' Print results (selected numbers)
645 For i1 = 1 To 64
Cells(n9, i1).Value = c(i1)
Next i1
Cells(n9, 65).Select
Cells(n9, 65).Value = n9
Return
' Print results (squares)
650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 9: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 9
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 8
For i2 = 1 To 8
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = c(i3)
Next i2
Next i1
Return
End Sub
