' Generates Composed Magic Squares (Hendricks) of order 12, magic sum 870
' Tested with Office 2007 under Windows 7
Sub MgcSqr12d()
Dim a(144), b(144), c(144)
y = MsgBox("Locked", vbCritical, "Routine MgcSqr12d")
End
k1 = 1: k2 = 1: n2 = 0: n9 = 0
m1 = 1: m2 = 144: s1 = 870
' Generate data
Sheets("Klad1").Select
t1 = Timer
For j144 = m1 To m2 'a(144)
If b(j144) = 0 Then b(j144) = j144: c(144) = j144 Else GoTo 1440
a(144) = j144
For j143 = m1 To m2 'a(143)
If b(j143) = 0 Then b(j143) = j143: c(143) = j143 Else GoTo 1430
a(143) = j143
For j142 = m1 To m2 'a(142)
If b(j142) = 0 Then b(j142) = j142: c(142) = j142 Else GoTo 1420
a(142) = j142
jj = 142
a(141) = 290 - a(142) - a(143) - a(144)
j = 141: GoSub 3000: If fl1 = 1 Then GoTo 1420
For j140 = m1 To m2 'a(140)
If b(j140) = 0 Then b(j140) = j140: c(140) = j140 Else GoTo 1400
a(140) = j140
jj = 140
a(139) = -a(140) + a(143) + a(144)
j = 139: GoSub 3000: If fl1 = 1 Then GoTo 1400
a(138) = a(140) + a(142) - a(144)
j = 138: GoSub 3000: If fl1 = 1 Then GoTo 1400
a(137) = 290 - a(140) - a(142) - a(143)
j = 137: GoSub 3000: If fl1 = 1 Then GoTo 1400
For j136 = m1 To m2 'a(136)
If b(j136) = 0 Then b(j136) = j136: c(136) = j136 Else GoTo 1360
a(136) = j136
jj = 136
a(135) = -a(136) + a(143) + a(144)
j = 135: GoSub 3000: If fl1 = 1 Then GoTo 1360
a(134) = a(136) + a(142) - a(144)
j = 134: GoSub 3000: If fl1 = 1 Then GoTo 1360
a(133) = 290 - a(136) - a(142) - a(143)
j = 133: GoSub 3000: If fl1 = 1 Then GoTo 1360
For j132 = m1 To m2 'a(132)
If b(j132) = 0 Then b(j132) = j132: c(132) = j132 Else GoTo 1320
a(132) = j132
jj = 132
a(131) = 290 - a(132) - a(143) - a(144): j = 131: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(130) = a(132) - a(142) + a(144): j = 130: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(129) = -a(132) + a(142) + a(143): j = 129: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(128) = a(132) + a(140) - a(144): j = 128: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(127) = 290 - a(132) - a(140) - a(143): j = 127: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(126) = a(132) + a(140) - a(142): j = 126: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(125) = -a(132) - a(140) + a(142) + a(143) + a(144): j = 125: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(124) = a(132) + a(136) - a(144): j = 124: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(123) = 290 - a(132) - a(136) - a(143): j = 123: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(122) = a(132) + a(136) - a(142): j = 122: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(121) = -a(132) - a(136) + a(142) + a(143) + a(144): j = 121: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(120) = 145 - a(142): j = 120: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(119) = -145 + a(142) + a(143) + a(144): j = 119: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(118) = 145 - a(144): j = 118: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(117) = 145 - a(143): j = 117: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(116) = 145 - a(140) - a(142) + a(144): j = 116: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(115) = -145 + a(140) + a(142) + a(143): j = 115: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(114) = 145 - a(140): j = 114: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(113) = 145 + a(140) - a(143) - a(144): j = 113: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(112) = 145 - a(136) - a(142) + a(144): j = 112: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(111) = -145 + a(136) + a(142) + a(143): j = 111: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(110) = 145 - a(136): j = 110: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(109) = 145 + a(136) - a(143) - a(144): j = 109: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(108) = 145 - a(132) + a(142) - a(144): j = 108: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(107) = 145 + a(132) - a(142) - a(143): j = 107: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(106) = 145 - a(132): j = 106: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(105) = -145 + a(132) + a(143) + a(144): j = 105: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(104) = 145 - a(132) - a(140) + a(142): j = 104: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(103) = 145 + a(132) + a(140) - a(142) - a(143) - a(144): j = 103: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(102) = 145 - a(132) - a(140) + a(144): j = 102: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(101) = -145 + a(132) + a(140) + a(143): j = 101: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(100) = 145 - a(132) - a(136) + a(142): j = 100: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(99) = 145 + a(132) + a(136) - a(142) - a(143) - a(144): j = 99: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(98) = 145 - a(132) - a(136) + a(144): j = 98: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(97) = -145 + a(132) + a(136) + a(143): j = 97: GoSub 3000: If fl1 = 1 Then GoTo 1320
For j96 = m1 To m2 'a(96)
If b(j96) = 0 Then b(j96) = j96: c(96) = j96 Else GoTo 960
a(96) = j96
jj = 96
a(95) = a(96) + a(143) - a(144): j = 95: GoSub 3000: If fl1 = 1 Then GoTo 960
a(94) = -a(96) + a(142) + a(144): j = 94: GoSub 3000: If fl1 = 1 Then GoTo 960
a(93) = 290 - a(96) - a(142) - a(143): j = 93: GoSub 3000: If fl1 = 1 Then GoTo 960
a(92) = a(96) + a(140) - a(144): j = 92: GoSub 3000: If fl1 = 1 Then GoTo 960
a(91) = a(96) - a(140) + a(143): j = 91: GoSub 3000: If fl1 = 1 Then GoTo 960
a(90) = -a(96) + a(140) + a(142): j = 90: GoSub 3000: If fl1 = 1 Then GoTo 960
a(89) = 290 - a(96) - a(140) - a(142) - a(143) + a(144): j = 89: GoSub 3000: If fl1 = 1 Then GoTo 960
a(88) = a(96) + a(136) - a(144): j = 88: GoSub 3000: If fl1 = 1 Then GoTo 960
a(87) = a(96) - a(136) + a(143): j = 87: GoSub 3000: If fl1 = 1 Then GoTo 960
a(86) = -a(96) + a(136) + a(142): j = 86: GoSub 3000: If fl1 = 1 Then GoTo 960
a(85) = 290 - a(96) - a(136) - a(142) - a(143) + a(144): j = 85: GoSub 3000: If fl1 = 1 Then GoTo 960
a(84) = -a(96) + a(132) + a(144): j = 84: GoSub 3000: If fl1 = 1 Then GoTo 960
a(83) = 290 - a(96) - a(132) - a(143): j = 83: GoSub 3000: If fl1 = 1 Then GoTo 960
a(82) = a(96) + a(132) - a(142): j = 82: GoSub 3000: If fl1 = 1 Then GoTo 960
a(81) = a(96) - a(132) + a(142) + a(143) - a(144): j = 81: GoSub 3000: If fl1 = 1 Then GoTo 960
a(80) = -a(96) + a(132) + a(140): j = 80: GoSub 3000: If fl1 = 1 Then GoTo 960
a(79) = 290 - a(96) - a(132) - a(140) - a(143) + a(144): j = 79: GoSub 3000: If fl1 = 1 Then GoTo 960
a(78) = a(96) + a(132) + a(140) - a(142) - a(144): j = 78: GoSub 3000: If fl1 = 1 Then GoTo 960
a(77) = a(96) - a(132) - a(140) + a(142) + a(143): j = 77: GoSub 3000: If fl1 = 1 Then GoTo 960
a(76) = -a(96) + a(132) + a(136): j = 76: GoSub 3000: If fl1 = 1 Then GoTo 960
a(75) = 290 - a(96) - a(132) - a(136) - a(143) + a(144): j = 75: GoSub 3000: If fl1 = 1 Then GoTo 960
a(74) = a(96) + a(132) + a(136) - a(142) - a(144): j = 74: GoSub 3000: If fl1 = 1 Then GoTo 960
a(73) = a(96) - a(132) - a(136) + a(142) + a(143): j = 73: GoSub 3000: If fl1 = 1 Then GoTo 960
a(72) = 145 + a(96) - a(142) - a(144): j = 72: GoSub 3000: If fl1 = 1 Then GoTo 960
a(71) = -145 + a(96) + a(142) + a(143): j = 71: GoSub 3000: If fl1 = 1 Then GoTo 960
a(70) = 145 - a(96): j = 70: GoSub 3000: If fl1 = 1 Then GoTo 960
a(69) = 145 - a(96) - a(143) + a(144): j = 69: GoSub 3000: If fl1 = 1 Then GoTo 960
a(68) = 145 + a(96) - a(140) - a(142): j = 68: GoSub 3000: If fl1 = 1 Then GoTo 960
a(67) = -145 + a(96) + a(140) + a(142) + a(143) - a(144): j = 67: GoSub 3000: If fl1 = 1 Then GoTo 960
a(66) = 145 - a(96) - a(140) + a(144): j = 66: GoSub 3000: If fl1 = 1 Then GoTo 960
a(65) = 145 - a(96) + a(140) - a(143): j = 65: GoSub 3000: If fl1 = 1 Then GoTo 960
a(64) = 145 + a(96) - a(136) - a(142): j = 64: GoSub 3000: If fl1 = 1 Then GoTo 960
a(63) = -145 + a(96) + a(136) + a(142) + a(143) - a(144): j = 63: GoSub 3000: If fl1 = 1 Then GoTo 960
a(62) = 145 - a(96) - a(136) + a(144): j = 62: GoSub 3000: If fl1 = 1 Then GoTo 960
a(61) = 145 - a(96) + a(136) - a(143): j = 61: GoSub 3000: If fl1 = 1 Then GoTo 960
a(60) = 145 - a(96) - a(132) + a(142): j = 60: GoSub 3000: If fl1 = 1 Then GoTo 960
a(59) = 145 - a(96) + a(132) - a(142) - a(143) + a(144): j = 59: GoSub 3000: If fl1 = 1 Then GoTo 960
a(58) = 145 + a(96) - a(132) - a(144): j = 58: GoSub 3000: If fl1 = 1 Then GoTo 960
a(57) = -145 + a(96) + a(132) + a(143): j = 57: GoSub 3000: If fl1 = 1 Then GoTo 960
a(56) = 145 - a(96) - a(132) - a(140) + a(142) + a(144): j = 56: GoSub 3000: If fl1 = 1 Then GoTo 960
a(55) = 145 - a(96) + a(132) + a(140) - a(142) - a(143): j = 55: GoSub 3000: If fl1 = 1 Then GoTo 960
a(54) = 145 + a(96) - a(132) - a(140): j = 54: GoSub 3000: If fl1 = 1 Then GoTo 960
a(53) = -145 + a(96) + a(132) + a(140) + a(143) - a(144): j = 53: GoSub 3000: If fl1 = 1 Then GoTo 960
a(52) = 145 - a(96) - a(132) - a(136) + a(142) + a(144): j = 52: GoSub 3000: If fl1 = 1 Then GoTo 960
a(51) = 145 - a(96) + a(132) + a(136) - a(142) - a(143): j = 51: GoSub 3000: If fl1 = 1 Then GoTo 960
a(50) = 145 + a(96) - a(132) - a(136): j = 50: GoSub 3000: If fl1 = 1 Then GoTo 960
a(49) = -145 + a(96) + a(132) + a(136) + a(143) - a(144): j = 49: GoSub 3000: If fl1 = 1 Then GoTo 960
For j48 = 'm1 To m2 'a(48)
If b(j48) = 0 Then b(j48) = j48: c(48) = j48 Else GoTo 480
a(48) = j48
jj = 48
a(47) = a(48) + a(143) - a(144): j = 47: GoSub 3000: If fl1 = 1 Then GoTo 480
a(46) = -a(48) + a(142) + a(144): j = 46: GoSub 3000: If fl1 = 1 Then GoTo 480
a(45) = 290 - a(48) - a(142) - a(143): j = 45: GoSub 3000: If fl1 = 1 Then GoTo 480
a(44) = a(48) + a(140) - a(144): j = 44: GoSub 3000: If fl1 = 1 Then GoTo 480
a(43) = a(48) - a(140) + a(143): j = 43: GoSub 3000: If fl1 = 1 Then GoTo 480
a(42) = -a(48) + a(140) + a(142): j = 42: GoSub 3000: If fl1 = 1 Then GoTo 480
a(41) = 290 - a(48) - a(140) - a(142) - a(143) + a(144): j = 41: GoSub 3000: If fl1 = 1 Then GoTo 480
a(40) = a(48) + a(136) - a(144): j = 40: GoSub 3000: If fl1 = 1 Then GoTo 480
a(39) = a(48) - a(136) + a(143): j = 39: GoSub 3000: If fl1 = 1 Then GoTo 480
a(38) = -a(48) + a(136) + a(142): j = 38: GoSub 3000: If fl1 = 1 Then GoTo 480
a(37) = 290 - a(48) - a(136) - a(142) - a(143) + a(144): j = 37: GoSub 3000: If fl1 = 1 Then GoTo 480
a(36) = -a(48) + a(132) + a(144): j = 36: GoSub 3000: If fl1 = 1 Then GoTo 480
a(35) = 290 - a(48) - a(132) - a(143): j = 35: GoSub 3000: If fl1 = 1 Then GoTo 480
a(34) = a(48) + a(132) - a(142): j = 34: GoSub 3000: If fl1 = 1 Then GoTo 480
a(33) = a(48) - a(132) + a(142) + a(143) - a(144): j = 33: GoSub 3000: If fl1 = 1 Then GoTo 480
a(32) = -a(48) + a(132) + a(140): j = 32: GoSub 3000: If fl1 = 1 Then GoTo 480
a(31) = 290 - a(48) - a(132) - a(140) - a(143) + a(144): j = 31: GoSub 3000: If fl1 = 1 Then GoTo 480
a(30) = a(48) + a(132) + a(140) - a(142) - a(144): j = 30: GoSub 3000: If fl1 = 1 Then GoTo 480
a(29) = a(48) - a(132) - a(140) + a(142) + a(143): j = 29: GoSub 3000: If fl1 = 1 Then GoTo 480
a(28) = -a(48) + a(132) + a(136): j = 28: GoSub 3000: If fl1 = 1 Then GoTo 480
a(27) = 290 - a(48) - a(132) - a(136) - a(143) + a(144): j = 27: GoSub 3000: If fl1 = 1 Then GoTo 480
a(26) = a(48) + a(132) + a(136) - a(142) - a(144): j = 26: GoSub 3000: If fl1 = 1 Then GoTo 480
a(25) = a(48) - a(132) - a(136) + a(142) + a(143): j = 25: GoSub 3000: If fl1 = 1 Then GoTo 480
a(24) = 145 + a(48) - a(142) - a(144): j = 24: GoSub 3000: If fl1 = 1 Then GoTo 480
a(23) = -145 + a(48) + a(142) + a(143): j = 23: GoSub 3000: If fl1 = 1 Then GoTo 480
a(22) = 145 - a(48): j = 22: GoSub 3000: If fl1 = 1 Then GoTo 480
a(21) = 145 - a(48) - a(143) + a(144): j = 21: GoSub 3000: If fl1 = 1 Then GoTo 480
a(20) = 145 + a(48) - a(140) - a(142): j = 20: GoSub 3000: If fl1 = 1 Then GoTo 480
a(19) = -145 + a(48) + a(140) + a(142) + a(143) - a(144): j = 19: GoSub 3000: If fl1 = 1 Then GoTo 480
a(18) = 145 - a(48) - a(140) + a(144): j = 18: GoSub 3000: If fl1 = 1 Then GoTo 480
a(17) = 145 - a(48) + a(140) - a(143): j = 17: GoSub 3000: If fl1 = 1 Then GoTo 480
a(16) = 145 + a(48) - a(136) - a(142): j = 16: GoSub 3000: If fl1 = 1 Then GoTo 480
a(15) = -145 + a(48) + a(136) + a(142) + a(143) - a(144): j = 15: GoSub 3000: If fl1 = 1 Then GoTo 480
a(14) = 145 - a(48) - a(136) + a(144): j = 14: GoSub 3000: If fl1 = 1 Then GoTo 480
a(13) = 145 - a(48) + a(136) - a(143): j = 13: GoSub 3000: If fl1 = 1 Then GoTo 480
a(12) = 145 - a(48) - a(132) + a(142): j = 12: GoSub 3000: If fl1 = 1 Then GoTo 480
a(11) = 145 - a(48) + a(132) - a(142) - a(143) + a(144): j = 11: GoSub 3000: If fl1 = 1 Then GoTo 480
a(10) = 145 + a(48) - a(132) - a(144): j = 10: GoSub 3000: If fl1 = 1 Then GoTo 480
a(9) = -145 + a(48) + a(132) + a(143): j = 9: GoSub 3000: If fl1 = 1 Then GoTo 480
a(8) = 145 - a(48) - a(132) - a(140) + a(142) + a(144): j = 8: GoSub 3000: If fl1 = 1 Then GoTo 480
a(7) = 145 - a(48) + a(132) + a(140) - a(142) - a(143): j = 7: GoSub 3000: If fl1 = 1 Then GoTo 480
a(6) = 145 + a(48) - a(132) - a(140): j = 6: GoSub 3000: If fl1 = 1 Then GoTo 480
a(5) = -145 + a(48) + a(132) + a(140) + a(143) - a(144): j = 5: GoSub 3000: If fl1 = 1 Then GoTo 480
a(4) = 145 - a(48) - a(132) - a(136) + a(142) + a(144): j = 4: GoSub 3000: If fl1 = 1 Then GoTo 480
a(3) = 145 - a(48) + a(132) + a(136) - a(142) - a(143): j = 3: GoSub 3000: If fl1 = 1 Then GoTo 480
a(2) = 145 + a(48) - a(132) - a(136): j = 2: GoSub 3000: If fl1 = 1 Then GoTo 480
a(1) = -145 + a(48) + a(132) + a(136) + a(143) - a(144): j = 1: GoSub 3000: If fl1 = 1 Then GoTo 480
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers
jj = 48: GoSub 3050 'Reset b() and c()
480 Next j48
jj = 96: GoSub 3050 'Reset b() and c()
960 Next j96
jj = 132: GoSub 3050 'Reset b() and c()
1320 Next j132
jj = 136: GoSub 3050 'Reset b() and c()
1360 Next j136
jj = 140: GoSub 3050 'Reset b() and c()
1400 Next j140
jj = 142: GoSub 3050 'Reset b() and c()
1420 Next j142
b(c(143)) = 0: c(143) = 0
1430 Next j143
b(c(144)) = 0: c(144) = 0
1440 Next j144
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine MgcSqr12d")
End
' Print results (selected numbers)
2645 For i1 = 1 To 144
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 3 Then
n2 = 1: k1 = k1 + 13: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 13
End If
Cells(k1 + 1, k2 + 1).Select
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 12
For i2 = 1 To 12
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
' Exclude identical solutions and solutions out of range
3000 fl1 = 0
If a(j) <= 0 Or a(j) > 144 Then fl1 = 1: GoTo 3010
If b(a(j)) = 0 Then b(a(j)) = a(j): c(j) = a(j) Else fl1 = 1
3010 If fl1 = 1 Then 'Reset b() and c()
For i = j + 1 To jj
b(c(i)) = 0: c(i) = 0
Next i
End If
Return
' Reset b() and c() after completion loop
3050 For i = j To jj
b(c(i)) = 0: c(i) = 0
Next i
Return
End Sub
