' Constructs Four Way V type ZigZag Magic Squares (8 x 8)
' Tested with Office 2007 under Windows 7
Sub Medjig8()
Dim a(16), b(64), c(64), s(20)
y = MsgBox("Locked", vbCritical, "Routine Medjig8")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
ShtNm1 = "Lns17645": n4 = 1513 'Pan Magic Complete Medjig Squares
' ShtNm1 = "Lns17643": n4 = 193 'Associated Medjig Squares
t1 = Timer
For j100 = 2 To n4 'Select Medjig Square
Cells(k1, 1).Select: Cells(k1, 1).Value = j100
For i1 = 1 To 64
b(i1) = Sheets(ShtNm1).Cells(j100, i1).Value
Next i1
For j200 = 2 To 4 'Select 4 x 4 Base Square A: 2 ... 4 Pan Magic
' 6 ... 53 Associated (unique)
For i1 = 1 To 16
a(i1) = Sheets("Lines4").Cells(j200, i1).Value
Next i1
' Calculate Square C
For i1 = 1 To 16
Select Case i1
Case 1
c(1) = a(1) + 16 * b(1): c(2) = a(1) + 16 * b(2):
c(9) = a(1) + 16 * b(9): c(10) = a(1) + 16 * b(10):
Case 2
c(3) = a(2) + 16 * b(3): c(4) = a(2) + 16 * b(4):
c(11) = a(2) + 16 * b(11): c(12) = a(2) + 16 * b(12):
Case 3
c(5) = a(3) + 16 * b(5): c(6) = a(3) + 16 * b(6):
c(13) = a(3) + 16 * b(13): c(14) = a(3) + 16 * b(14):
Case 4
c(7) = a(4) + 16 * b(7): c(8) = a(4) + 16 * b(8):
c(15) = a(4) + 16 * b(15): c(16) = a(4) + 16 * b(16):
Case 5
c(17) = a(5) + 16 * b(17): c(18) = a(5) + 16 * b(18):
c(25) = a(5) + 16 * b(25): c(26) = a(5) + 16 * b(26):
Case 6
c(19) = a(6) + 16 * b(19): c(20) = a(6) + 16 * b(20):
c(27) = a(6) + 16 * b(27): c(28) = a(6) + 16 * b(28):
Case 7
c(21) = a(7) + 16 * b(21): c(22) = a(7) + 16 * b(22):
c(29) = a(7) + 16 * b(29): c(30) = a(7) + 16 * b(30):
Case 8
c(23) = a(8) + 16 * b(23): c(24) = a(8) + 16 * b(24):
c(31) = a(8) + 16 * b(31): c(32) = a(8) + 16 * b(32):
Case 9
c(33) = a(9) + 16 * b(33): c(34) = a(9) + 16 * b(34):
c(41) = a(9) + 16 * b(41): c(42) = a(9) + 16 * b(42):
Case 10
c(35) = a(10) + 16 * b(35): c(36) = a(10) + 16 * b(36):
c(43) = a(10) + 16 * b(43): c(44) = a(10) + 16 * b(44):
Case 11
c(37) = a(11) + 16 * b(37): c(38) = a(11) + 16 * b(38):
c(45) = a(11) + 16 * b(45): c(46) = a(11) + 16 * b(46):
Case 12
c(39) = a(12) + 16 * b(39): c(40) = a(12) + 16 * b(40):
c(47) = a(12) + 16 * b(47): c(48) = a(12) + 16 * b(48):
Case 13
c(49) = a(13) + 16 * b(49): c(50) = a(13) + 16 * b(50):
c(57) = a(13) + 16 * b(57): c(58) = a(13) + 16 * b(58):
Case 14
c(51) = a(14) + 16 * b(51): c(52) = a(14) + 16 * b(52):
c(59) = a(14) + 16 * b(59): c(60) = a(14) + 16 * b(60):
Case 15
c(53) = a(15) + 16 * b(53): c(54) = a(15) + 16 * b(54):
c(61) = a(15) + 16 * b(61): c(62) = a(15) + 16 * b(62):
Case 16
c(55) = a(16) + 16 * b(55): c(56) = a(16) + 16 * b(56):
c(63) = a(16) + 16 * b(63): c(64) = a(16) + 16 * 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
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine Medjig8")
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
