' Generates Simple SelfOrthogonal Latin Diagonal Squares (9 x 9)
' Third-rows and Third-columns Summing to s1/3
'Unique a(1) < a(9), a(73), a(81)
'Unique a(9) < a(73)
' Tested with Office 365 under Windows 11
Sub SelfOrth9e2()
Dim a(81), b(9), a1(9)
Dim b2(81), c2(81), a0(9, 9)
Dim s(81)
y = MsgBox("Locked", vbCritical, "Routine SelfOrth9e2")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 9: s1 = 36: s3 = s1 / 3
For i1 = 1 To 9: a1(i1) = i1 - 1: Next i1
Sheets("Klad1").Select
t1 = Timer
' Diagonal 1
For j01 = m1 To m2
a(1) = a1(j01)
For j11 = m1 To m2
a(11) = a1(j11)
If a(11) = a(1) Then GoTo 110
For j21 = m1 To m2
a(21) = a1(j21)
If a(21) = a(11) Or a(21) = a(1) Then GoTo 210
For j31 = m1 To m2
a(31) = a1(j31)
If a(31) = a(21) Or a(31) = a(11) Or a(31) = a(1) Then GoTo 310
For j41 = m1 To m2
a(41) = a1(j41)
If a(41) = a(31) Or a(41) = a(21) Or a(41) = a(11) Or a(41) = a(1) Then GoTo 410
For j51 = m1 To m2
a(51) = a1(j51)
If a(51) = a(31) Or a(51) = a(21) Or a(51) = a(11) Or a(51) = a(1) Then GoTo 510
If a(51) = a(41) Then GoTo 510
For j61 = m1 To m2
a(61) = a1(j61)
If a(61) = a(31) Or a(61) = a(21) Or a(61) = a(11) Or a(61) = a(1) Then GoTo 610
If a(61) = a(51) Or a(61) = a(41) Then GoTo 610
For j71 = m1 To m2
a(71) = a1(j71)
If a(71) = a(31) Or a(71) = a(21) Or a(71) = a(11) Or a(71) = a(1) Then GoTo 710
If a(71) = a(61) Or a(71) = a(51) Or a(71) = a(41) Then GoTo 710
a(81) = s1 - a(1) - a(11) - a(21) - a(31) - a(41) - a(51) - a(61) - a(71)
If a(81) < a1(m1) Or a(81) > a1(m2) Then GoTo 810
If a(81) < a(1) Then GoTo 810 'Unique
' Back Check Diagonal 1
i2 = 0: For i1 = 1 To 81 Step 10: i2 = i2 + 1: b(i2) = a(i1): Next i1
n81 = 9: GoSub 1860: If fl1 = 0 Then GoTo 810
' Diagonal 2
For j9 = j01 + 1 To m2 'Unique
a(9) = a1(j9)
If a(9) = a(41) Or a(9) = a(1) Or a(9) = a(81) Then GoTo 90
For j73 = j9 + 1 To m2 'Unique
a(73) = a1(j73)
If a(73) = a(41) Or a(73) = a(9) Or a(73) = a(1) Or a(73) = a(81) Then GoTo 730
For j65 = m1 To m2
a(65) = a1(j65)
If a(65) = a(41) Or a(65) = a(73) Or a(65) = a(9) Then GoTo 650
If a(65) = a(11) Or a(65) = a(71) Then GoTo 650
For j57 = m1 To m2
a(57) = a1(j57)
If a(57) = a(41) Or a(57) = a(73) Or a(57) = a(65) Or a(57) = a(9) Then GoTo 570
If a(57) = a(21) Or a(57) = a(61) Then GoTo 570
For j49 = m1 To m2
a(49) = a1(j49)
If a(49) = a(41) Or a(49) = a(73) Or a(49) = a(65) Or a(49) = a(57) Or a(49) = a(9) Then GoTo 490
If a(49) = a(31) Or a(49) = a(51) Then GoTo 490
For j33 = m1 To m2
a(33) = a1(j33)
If a(33) = a(41) Or a(33) = a(73) Or a(33) = a(65) Or a(33) = a(57) Or a(33) = a(9) Then GoTo 330
If a(33) = a(49) Then GoTo 330
If a(33) = a(31) Or a(33) = a(51) Then GoTo 330
For j25 = m1 To m2
a(25) = a1(j25)
If a(25) = a(41) Or a(25) = a(73) Or a(25) = a(65) Or a(25) = a(57) Or a(25) = a(9) Then GoTo 250
If a(25) = a(49) Or a(25) = a(33) Then GoTo 250
If a(25) = a(21) Or a(25) = a(61) Then GoTo 250
a(17) = s1 - a(9) - a(25) - a(33) - a(41) - a(49) - a(57) - a(65) - a(73)
If a(17) < a1(m1) Or a(17) > a1(m2) Then GoTo 170
If a(17) = a(11) Or a(17) = a(71) Then GoTo 170
' Back Check Diagonal 2
i2 = 0: For i1 = 9 To 73 Step 8: i2 = i2 + 1: b(i2) = a(i1): Next i1
n81 = 9: GoSub 1860: If fl1 = 0 Then GoTo 170
GoSub 1500: If fl1 = 0 Then GoTo 170 'Check Self Orthogonal
''n9 = n9 + 1: GoSub 2650: End
' Center Square
a(50) = s3 - a(49) - a(51)
If a(50) < a1(m1) Or a(50) > a1(m2) Then GoTo 500
If a(50) = a(49) Or a(50) = a(51) Then GoTo 500
a(40) = s3 - a(49) - a(31)
If a(40) < a1(m1) Or a(40) > a1(m2) Then GoTo 400
If a(40) = a(49) Or a(40) = a(31) Then GoTo 400
a(32) = s3 - a(31) - a(33)
If a(32) < a1(m1) Or a(32) > a1(m2) Then GoTo 320
If a(32) = a(31) Or a(32) = a(33) Then GoTo 320
a(42) = s3 - a(33) - a(51)
If a(42) < a1(m1) Or a(42) > a1(m2) Then GoTo 420
If a(42) = a(33) Or a(42) = a(51) Then GoTo 420
'Right/Bottom
For j80 = m1 To m2
a(80) = a1(j80)
If a(80) = a(71) Or a(80) = a(17) Then GoTo 800
If a(80) = a(81) Or a(80) = a(73) Then GoTo 800
a(79) = s3 - a(80) - a(81):
If a(79) < a1(m1) Or a(79) > a1(m2) Then GoTo 790:
If a(79) = a(73) Or a(79) = a(80) Or a(79) = a(81) Then GoTo 790
If a(79) = a(61) Or a(79) = a(25) Then GoTo 790
a(70) = s3 - a(79) - a(61):
If a(70) < a1(m1) Or a(70) > a1(m2) Then GoTo 700:
If a(70) = a(79) Or a(70) = a(61) Or a(70) = a(25) Then GoTo 700
If a(70) = a(65) Or a(70) = a(71) Then GoTo 700
a(72) = s3 - a(70) - a(71):
If a(72) < a1(m1) Or a(72) > a1(m2) Then GoTo 720:
If a(72) = a(65) Or a(72) = a(70) Or a(72) = a(71) Then GoTo 720
If a(72) = a(81) Or a(72) = a(9) Then GoTo 720
a(63) = s3 - a(72) - a(81):
If a(63) < a1(m1) Or a(63) > a1(m2) Then GoTo 630:
If a(63) = a(72) Or a(63) = a(81) Or a(63) = a(9) Then GoTo 630
If a(63) = a(57) Or a(63) = a(61) Then GoTo 630
a(62) = s3 - a(80) - a(71):
If a(62) < a1(m1) Or a(62) > a1(m2) Then GoTo 620:
If a(62) = a(80) Or a(62) = a(71) Or a(62) = a(17) Then GoTo 620
If a(62) = a(57) Or a(62) = a(61) Or a(62) = a(63) Then GoTo 620
'Left/Top
For j20 = m1 To m2
a(20) = a1(j20)
If a(20) = a(21) Or a(20) = a(25) Then GoTo 200
If a(20) = a(11) Or a(20) = a(65) Then GoTo 200
a(19) = s3 - a(20) - a(21):
If a(19) < a1(m1) Or a(19) > a1(m2) Then GoTo 190:
If a(19) = a(20) Or a(19) = a(21) Or a(19) = a(25) Then GoTo 190
If a(19) = a(1) Or a(19) = a(73) Then GoTo 190
a(10) = s3 - a(19) - a(1):
If a(10) < a1(m1) Or a(10) > a1(m2) Then GoTo 100:
If a(10) = a(73) Or a(10) = a(19) Or a(10) = a(1) Then GoTo 100
If a(10) = a(11) Or a(10) = a(17) Then GoTo 100
a(12) = s3 - a(10) - a(11):
If a(12) < a1(m1) Or a(12) > a1(m2) Then GoTo 120:
If a(12) = a(10) Or a(12) = a(11) Or a(12) = a(17) Then GoTo 120
If a(12) = a(21) Or a(12) = a(57) Then GoTo 120
a(3) = s3 - a(12) - a(21):
If a(3) < a1(m1) Or a(3) > a1(m2) Then GoTo 30:
If a(3) = a(12) Or a(3) = a(21) Or a(3) = a(57) Then GoTo 30
If a(3) = a(1) Or a(3) = a(9) Then GoTo 30
a(2) = s3 - a(20) - a(11):
If a(2) < a1(m1) Or a(2) > a1(m2) Then GoTo 20:
If a(2) = a(20) Or a(2) = a(11) Or a(2) = a(65) Then GoTo 20
If a(2) = a(1) Or a(2) = a(3) Or a(2) = a(9) Then GoTo 20
GoSub 1500: If fl1 = 0 Then GoTo 20 'Check Self Orthogonal
'Left/Bottom
For j74 = m1 To m2
a(74) = a1(j74)
If a(74) = a(73) Or a(74) = a(79) Or a(74) = a(80) Or a(74) = a(81) Then GoTo 740
If a(74) = a(2) Or a(74) = a(11) Or a(74) = a(20) Or a(74) = a(65) Then GoTo 740
a(75) = s3 - a(74) - a(73):
If a(75) < a1(m1) Or a(75) > a1(m2) Then GoTo 750:
If a(75) = a(73) Or a(75) = a(74) Or a(75) = a(79) Or a(75) = a(80) Or a(75) = a(81) Then GoTo 750
If a(75) = a(3) Or a(75) = a(12) Or a(75) = a(21) Or a(75) = a(57) Then GoTo 750
a(66) = s3 - a(75) - a(57):
If a(66) < a1(m1) Or a(66) > a1(m2) Then GoTo 660:
If a(66) = a(65) Or a(66) = a(70) Or a(66) = a(71) Or a(66) = a(72) Then GoTo 660
If a(66) = a(3) Or a(66) = a(12) Or a(66) = a(21) Or a(66) = a(57) Or a(66) = a(75) Then GoTo 660
a(64) = s3 - a(66) - a(65):
If a(64) < a1(m1) Or a(64) > a1(m2) Then GoTo 640:
If a(64) = a(65) Or a(64) = a(66) Or a(64) = a(70) Or a(64) = a(71) Or a(64) = a(72) Then GoTo 640
If a(64) = a(1) Or a(64) = a(10) Or a(64) = a(19) Or a(64) = a(73) Then GoTo 640
a(55) = s3 - a(64) - a(73):
If a(55) < a1(m1) Or a(55) > a1(m2) Then GoTo 550:
If a(55) = a(57) Or a(55) = a(61) Or a(55) = a(62) Or a(55) = a(63) Then GoTo 550
If a(55) = a(1) Or a(55) = a(10) Or a(55) = a(19) Or a(55) = a(73) Or a(55) = a(64) Then GoTo 550
a(56) = s3 - a(74) - a(65):
If a(56) < a1(m1) Or a(56) > a1(m2) Then GoTo 560:
If a(56) = a(55) Or a(56) = a(57) Or a(56) = a(61) Or a(56) = a(62) Or a(56) = a(63) Then GoTo 560
If a(56) = a(2) Or a(56) = a(11) Or a(56) = a(20) Or a(56) = a(74) Or a(56) = a(65) Then GoTo 560
'Right/Top
For j26 = m1 To m2
a(26) = a1(j26)
If a(26) = a(19) Or a(26) = a(20) Or a(26) = a(21) Or a(26) = a(25) Then GoTo 260
If a(26) = a(17) Or a(26) = a(62) Or a(26) = a(71) Or a(26) = a(80) Then GoTo 260
a(27) = s3 - a(26) - a(25):
If a(27) < a1(m1) Or a(27) > a1(m2) Then GoTo 270:
If a(27) = a(19) Or a(27) = a(20) Or a(27) = a(21) Or a(27) = a(25) Or a(27) = a(26) Then GoTo 270
If a(27) = a(9) Or a(27) = a(63) Or a(27) = a(72) Or a(27) = a(81) Then GoTo 270
a(18) = s3 - a(27) - a(9):
If a(18) < a1(m1) Or a(18) > a1(m2) Then GoTo 180:
If a(18) = a(10) Or a(18) = a(11) Or a(18) = a(12) Or a(18) = a(17) Then GoTo 180
If a(18) = a(9) Or a(18) = a(27) Or a(18) = a(63) Or a(18) = a(72) Or a(18) = a(81) Then GoTo 180
a(16) = s3 - a(18) - a(17):
If a(16) < a1(m1) Or a(16) > a1(m2) Then GoTo 160:
If a(16) = a(10) Or a(16) = a(11) Or a(16) = a(12) Or a(16) = a(17) Or a(16) = a(18) Then GoTo 160
If a(16) = a(25) Or a(16) = a(61) Or a(16) = a(70) Or a(16) = a(79) Then GoTo 160
a(7) = s3 - a(16) - a(25):
If a(7) < a1(m1) Or a(7) > a1(m2) Then GoTo 70:
If a(7) = a(1) Or a(7) = a(2) Or a(7) = a(3) Or a(7) = a(9) Then GoTo 70
If a(7) = a(16) Or a(7) = a(25) Or a(7) = a(61) Or a(7) = a(70) Or a(7) = a(79) Then GoTo 70
a(8) = s3 - a(26) - a(17):
If a(8) < a1(m1) Or a(8) > a1(m2) Then GoTo 80:
If a(8) = a(1) Or a(8) = a(2) Or a(8) = a(3) Or a(8) = a(7) Or a(8) = a(9) Then GoTo 80
If a(8) = a(17) Or a(8) = a(26) Or a(8) = a(62) Or a(8) = a(71) Or a(8) = a(80) Then GoTo 80
GoSub 1500: If fl1 = 0 Then GoTo 80 'Check Self Orthogonal
For j78 = m1 To m2
a(78) = a1(j78)
If a(78) = a(73) Or a(78) = a(74) Or a(78) = a(75) Or a(78) = a(79) Or a(78) = a(80) Or a(78) = a(81) Then GoTo 780
If a(78) = a(51) Or a(78) = a(42) Or a(78) = a(33) Then GoTo 780
For j77 = m1 To m2
a(77) = a1(j77)
If a(77) = a(73) Or a(77) = a(74) Or a(77) = a(75) Or a(77) = a(79) Or a(77) = a(80) Or a(77) = a(81) Then GoTo 770
If a(77) = a(78) Then GoTo 770
If a(77) = a(50) Or a(77) = a(41) Or a(77) = a(32) Then GoTo 770
a(76) = s3 - a(77) - a(78):
If a(76) < a1(m1) Or a(76) > a1(m2) Then GoTo 760:
If a(76) = a(49) Or a(76) = a(40) Or a(76) = a(31) Then GoTo 760
For j69 = m1 To m2
a(69) = a1(j69)
If a(69) = a(64) Or a(69) = a(65) Or a(69) = a(66) Or a(69) = a(70) Or a(69) = a(71) Or a(69) = a(72) Then GoTo 690
If a(69) = a(78) Or a(69) = a(51) Or a(69) = a(42) Or a(69) = a(33) Then GoTo 690
a(60) = s3 - a(69) - a(78):
If a(60) < a1(m1) Or a(60) > a1(m2) Then GoTo 600:
If a(60) = a(55) Or a(60) = a(56) Or a(60) = a(57) Or a(60) = a(61) Or a(60) = a(62) Or a(60) = a(63) Then GoTo 600
If a(60) = a(69) Or a(60) = a(78) Or a(60) = a(51) Or a(60) = a(42) Or a(60) = a(33) Then GoTo 600
For j68 = m1 To m2
a(68) = a1(j68)
If a(68) = a(64) Or a(68) = a(65) Or a(68) = a(66) Or a(68) = a(70) Or a(68) = a(71) Or a(68) = a(72) Then GoTo 680
If a(68) = a(69) Then GoTo 680
If a(68) = a(77) Or a(68) = a(50) Or a(68) = a(41) Or a(68) = a(32) Then GoTo 680
a(67) = s3 - a(68) - a(69):
If a(67) < a1(m1) Or a(67) > a1(m2) Then GoTo 670:
If a(67) = a(76) Or a(67) = a(49) Or a(67) = a(40) Or a(67) = a(31) Then GoTo 670
a(59) = s3 - a(68) - a(77):
If a(59) < a1(m1) Or a(59) > a1(m2) Then GoTo 590:
If a(59) = a(55) Or a(59) = a(56) Or a(59) = a(57) Or a(59) = a(61) Or a(59) = a(62) Or a(59) = a(63) Then GoTo 590
If a(59) = a(60) Then GoTo 590
If a(59) = a(68) Or a(59) = a(77) Or a(59) = a(50) Or a(59) = a(41) Or a(59) = a(32) Then GoTo 590
a(58) = s3 - a(59) - a(60):
If a(58) < a1(m1) Or a(58) > a1(m2) Then GoTo 580:
If a(58) = a(67) Or a(58) = a(76) Or a(58) = a(49) Or a(58) = a(40) Or a(58) = a(31) Then GoTo 580
For j54 = m1 To m2
a(54) = a1(j54)
If a(54) = a(49) Or a(54) = a(50) Or a(54) = a(51) Then GoTo 540
If a(54) = a(9) Or a(54) = a(18) Or a(54) = a(27) Or a(54) = a(63) Or a(54) = a(72) Or a(54) = a(81) Then GoTo 540
For j53 = m1 To m2
a(53) = a1(j53)
If a(53) = a(49) Or a(53) = a(50) Or a(53) = a(51) Or a(53) = a(54) Then GoTo 530
If a(53) = a(8) Or a(53) = a(17) Or a(53) = a(26) Or a(53) = a(62) Or a(53) = a(71) Or a(53) = a(80) Then GoTo 530
a(52) = s3 - a(53) - a(54):
If a(52) < a1(m1) Or a(52) > a1(m2) Then GoTo 520:
If a(52) = a(49) Or a(52) = a(50) Or a(52) = a(51) Or a(52) = a(53) Or a(52) = a(54) Then GoTo 520
If a(52) = a(7) Or a(52) = a(16) Or a(52) = a(25) Or a(52) = a(61) Or a(52) = a(70) Or a(52) = a(79) Then GoTo 520
For j45 = m1 To m2
a(45) = a1(j45)
If a(45) = a(40) Or a(45) = a(41) Or a(45) = a(42) Then GoTo 450
If a(45) = a(9) Or a(45) = a(18) Or a(45) = a(27) Or a(45) = a(63) Or a(45) = a(72) Or a(45) = a(81) Then GoTo 450
If a(45) = a(54) Then GoTo 450
a(36) = s3 - a(45) - a(54):
If a(36) < a1(m1) Or a(36) > a1(m2) Then GoTo 360:
If a(36) = a(31) Or a(36) = a(32) Or a(36) = a(33) Then GoTo 360
For j44 = m1 To m2
a(44) = a1(j44)
If a(44) = a(40) Or a(44) = a(41) Or a(44) = a(42) Or a(44) = a(45) Then GoTo 440
If a(44) = a(8) Or a(44) = a(17) Or a(44) = a(26) Or a(44) = a(62) Or a(44) = a(71) Or a(44) = a(80) Then GoTo 440
If a(44) = a(53) Then GoTo 440
a(43) = s3 - a(44) - a(45):
If a(43) < a1(m1) Or a(43) > a1(m2) Then GoTo 430:
If a(43) = a(40) Or a(43) = a(41) Or a(43) = a(42) Or a(43) = a(44) Or a(43) = a(45) Then GoTo 430
If a(43) = a(7) Or a(43) = a(16) Or a(43) = a(25) Or a(43) = a(61) Or a(43) = a(70) Or a(43) = a(79) Then GoTo 430
If a(43) = a(52) Then GoTo 430
a(35) = s3 - a(44) - a(53):
If a(35) < a1(m1) Or a(35) > a1(m2) Then GoTo 350:
If a(35) = a(31) Or a(35) = a(32) Or a(35) = a(33) Or a(35) = a(36) Then GoTo 350
a(34) = s3 - a(35) - a(36):
If a(34) < a1(m1) Or a(34) > a1(m2) Then GoTo 340:
If a(34) = a(31) Or a(34) = a(32) Or a(34) = a(33) Or a(34) = a(35) Or a(34) = a(36) Then GoTo 340
GoSub 1500: If fl1 = 0 Then GoTo 340 'Check Self Orthogonal
For j48 = m1 To m2
a(48) = a1(j48)
If a(48) = a(49) Or a(48) = a(50) Or a(48) = a(51) Or a(48) = a(52) Or a(48) = a(53) Or a(48) = a(54) Then GoTo 480
If a(48) = a(3) Or a(48) = a(12) Or a(48) = a(21) Or a(48) = a(57) Or a(48) = a(66) Or a(48) = a(75) Then GoTo 480
For j47 = m1 To m2
a(47) = a1(j47)
If a(47) = a(49) Or a(47) = a(50) Or a(47) = a(51) Or a(47) = a(52) Or a(47) = a(53) Or a(47) = a(54) Then GoTo 470
If a(47) = a(49) Then GoTo 470
If a(47) = a(2) Or a(47) = a(11) Or a(47) = a(20) Or a(47) = a(56) Or a(47) = a(65) Or a(47) = a(74) Then GoTo 470
a(46) = s3 - a(47) - a(48):
If a(46) < a1(m1) Or a(46) > a1(m2) Then GoTo 460:
If a(46) = a(1) Or a(46) = a(10) Or a(46) = a(19) Or a(46) = a(55) Or a(46) = a(64) Or a(46) = a(73) Then GoTo 460
For j39 = m1 To m2
a(39) = a1(j39)
If a(39) = a(40) Or a(39) = a(41) Or a(39) = a(42) Or a(39) = a(43) Or a(39) = a(44) Or a(39) = a(45) Then GoTo 390
If a(39) = a(3) Or a(39) = a(12) Or a(39) = a(21) Or a(39) = a(57) Or a(39) = a(66) Or a(39) = a(75) Then GoTo 390
If a(39) = a(48) Then GoTo 390
a(30) = s3 - a(39) - a(48):
If a(30) < a1(m1) Or a(30) > a1(m2) Then GoTo 300:
If a(30) = a(31) Or a(30) = a(32) Or a(30) = a(33) Or a(30) = a(34) Or a(30) = a(35) Or a(30) = a(36) Then GoTo 300
For j38 = m1 To m2
a(38) = a1(j38)
If a(38) = a(40) Or a(38) = a(41) Or a(38) = a(42) Or a(38) = a(43) Or a(38) = a(44) Or a(38) = a(45) Then GoTo 380
If a(38) = a(39) Then GoTo 380
If a(38) = a(2) Or a(38) = a(11) Or a(38) = a(20) Or a(38) = a(56) Or a(38) = a(65) Or a(38) = a(74) Then GoTo 380
If a(38) = a(47) Then GoTo 380
a(37) = s3 - a(38) - a(39):
If a(37) < a1(m1) Or a(37) > a1(m2) Then GoTo 370:
If a(37) = a(1) Or a(37) = a(10) Or a(37) = a(19) Or a(37) = a(55) Or a(37) = a(64) Or a(37) = a(73) Then GoTo 370
If a(37) = a(46) Then GoTo 370
a(29) = s3 - a(38) - a(47):
If a(29) < a1(m1) Or a(29) > a1(m2) Then GoTo 290:
If a(29) = a(31) Or a(29) = a(32) Or a(29) = a(33) Or a(29) = a(34) Or a(29) = a(35) Or a(29) = a(36) Then GoTo 290
If a(29) = a(30) Then GoTo 290
a(28) = s3 - a(29) - a(30):
If a(28) < a1(m1) Or a(28) > a1(m2) Then GoTo 280:
For j24 = m1 To m2
a(24) = a1(j24)
If a(24) = a(19) Or a(24) = a(20) Or a(24) = a(21) Or a(24) = a(25) Or a(24) = a(26) Or a(24) = a(27) Then GoTo 240
If a(24) = a(33) Or a(24) = a(42) Or a(24) = a(51) Or a(24) = a(60) Or a(24) = a(69) Or a(24) = a(78) Then GoTo 240
For j23 = m1 To m2
a(23) = a1(j23)
If a(23) = a(19) Or a(23) = a(20) Or a(23) = a(21) Or a(23) = a(25) Or a(23) = a(26) Or a(23) = a(27) Then GoTo 230
If a(23) = a(24) Then GoTo 230
If a(23) = a(32) Or a(23) = a(41) Or a(23) = a(50) Or a(23) = a(59) Or a(23) = a(68) Or a(23) = a(77) Then GoTo 230
a(22) = s3 - a(23) - a(24):
If a(22) < a1(m1) Or a(22) > a1(m2) Then GoTo 220:
If a(22) = a(31) Or a(22) = a(40) Or a(22) = a(49) Or a(22) = a(58) Or a(22) = a(67) Or a(22) = a(76) Then GoTo 220
For j15 = m1 To m2
a(15) = a1(j15)
If a(15) = a(10) Or a(15) = a(11) Or a(15) = a(12) Or a(15) = a(16) Or a(15) = a(17) Or a(15) = a(18) Then GoTo 150
If a(15) = a(33) Or a(15) = a(42) Or a(15) = a(51) Or a(15) = a(60) Or a(15) = a(69) Or a(15) = a(78) Then GoTo 150
If a(15) = a(24) Then GoTo 150
a(6) = s3 - a(15) - a(24):
If a(6) < a1(m1) Or a(6) > a1(m2) Then GoTo 60:
If a(6) = a(1) Or a(6) = a(2) Or a(6) = a(3) Or a(6) = a(7) Or a(6) = a(8) Or a(6) = a(9) Then GoTo 60
For j14 = m1 To m2
a(14) = a1(j14)
If a(14) = a(10) Or a(14) = a(11) Or a(14) = a(12) Or a(14) = a(16) Or a(14) = a(17) Or a(14) = a(18) Then GoTo 140
If a(14) = a(15) Then GoTo 140
If a(14) = a(32) Or a(14) = a(41) Or a(14) = a(50) Or a(14) = a(59) Or a(14) = a(68) Or a(14) = a(77) Then GoTo 140
If a(14) = a(23) Then GoTo 140
a(13) = s3 - a(14) - a(15):
If a(13) < a1(m1) Or a(13) > a1(m2) Then GoTo 130:
If a(13) = a(31) Or a(13) = a(40) Or a(13) = a(49) Or a(13) = a(58) Or a(13) = a(67) Or a(13) = a(76) Then GoTo 130
If a(13) = a(22) Then GoTo 130
a(5) = s3 - a(14) - a(23):
If a(5) < a1(m1) Or a(5) > a1(m2) Then GoTo 50:
If a(5) = a(1) Or a(5) = a(2) Or a(5) = a(3) Or a(5) = a(7) Or a(5) = a(8) Or a(5) = a(9) Then GoTo 50
If a(5) = a(6) Then GoTo 50
a(4) = s3 - a(5) - a(6):
If a(4) < a1(m1) Or a(4) > a1(m2) Then GoTo 40:
GoSub 1050: If fl1 = 1 Then GoTo 5 'Exclude Associated
GoSub 1450: If fl1 = 1 Then GoTo 5 'Exclude Compact Pan Magic
GoSub 1800: If fl1 = 0 Then GoTo 5 'Check Identical Numbers (Back Check)
GoSub 1500: If fl1 = 0 Then GoTo 5 'Check Self Orthogonal
n9 = n9 + 1: GoSub 2645: ''End
''Cells(1, 1).Value = n9
5
40 a(4) = 0
50 a(5) = 0
130 a(13) = 0
140 a(14) = 0
Next j14
60 a(6) = 0
150 a(15) = 0
Next j15
220 a(22) = 0
230 a(23) = 0
Next j23
240 a(24) = 0
Next j24
' ************
280 a(28) = 0
290 a(29) = 0
370 a(37) = 0
380 a(38) = 0
Next j38
300 a(30) = 0
390 a(39) = 0
Next j39
460 a(46) = 0
470 a(47) = 0
Next j47
480 a(48) = 0
Next j48
' ************
340 a(34) = 0
350 a(35) = 0
430 a(43) = 0
440 a(44) = 0
Next j44
360 a(36) = 0
450 a(45) = 0
Next j45
520 a(52) = 0
530 a(53) = 0
Next j53
540 a(54) = 0
Next j54
' ************
580 a(58) = 0
590 a(59) = 0
670 a(67) = 0
680 a(68) = 0
Next j68
600 a(60) = 0
690 a(69) = 0
Next j69
760 a(76) = 0
770 a(77) = 0
Next j77
780 a(78) = 0
Next j78
' ************
80 a(8) = 0
70 a(7) = 0
160 a(16) = 0
180 a(18) = 0
270 a(27) = 0
260 a(26) = 0
Next j26
' ************
560 a(56) = 0
550 a(55) = 0
640 a(64) = 0
660 a(66) = 0
750 a(75) = 0
740 a(74) = 0
Next j74
' ************
20 a(2) = 0
30 a(3) = 0
120 a(12) = 0
100 a(10) = 0
190 a(19) = 0
200 a(20) = 0
Next j20
' ************
620 a(62) = 0
630 a(63) = 0
720 a(72) = 0
700 a(70) = 0
790 a(79) = 0
800 a(80) = 0
Next j80
' ************
420 a(42) = 0
320 a(32) = 0
400 a(40) = 0
500 a(50) = 0
' ************
170 a(17) = 0
250 a(25) = 0
Next j25
330 a(33) = 0
Next j33
490 a(49) = 0
Next j49
570 a(57) = 0
Next j57
650 a(65) = 0
Next j65
730 a(73) = 0
Next j73
90 a(9) = 0
Next j9
' ************
810 a(81) = 0
710 a(71) = 0
Next j71
610 a(61) = 0
Next j61
510 a(51) = 0
Next j51
410 a(41) = 0
Next j41
310 a(31) = 0
Next j31
210 a(21) = 0
Next j21
110 a(11) = 0
Next j11
10 a(1) = 0
Next j01
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine SelfOrth9e2")
End
' Exclude solutions with identical numbers in rows, columns, diagonals
1800 fl1 = 1
' Rows
i1 = -8
For i0 = 1 To 9
i1 = i1 + 9
b(1) = a(i1): b(2) = a(i1 + 1): b(3) = a(i1 + 2): b(4) = a(i1 + 3): b(5) = a(i1 + 4)
b(6) = a(i1 + 5): b(7) = a(i1 + 6): b(8) = a(i1 + 7): b(9) = a(i1 + 8)
n81 = 9: GoSub 1860: If fl1 = 0 Then Return
Next i0
' Columns
i1 = 0
For i0 = 1 To 9
i1 = i1 + 1
b(1) = a(i1): b(2) = a(i1 + 9): b(3) = a(i1 + 18): b(4) = a(i1 + 27): b(5) = a(i1 + 36)
b(6) = a(i1 + 45): b(7) = a(i1 + 54): b(8) = a(i1 + 63): b(9) = a(i1 + 72)
n81 = 9: GoSub 1860: If fl1 = 0 Then Return
Next i0
' Main Diagonals
b(1) = a(1): b(2) = a(11): b(3) = a(21): b(4) = a(31): b(5) = a(41): b(6) = a(51): b(7) = a(61): b(8) = a(71): b(9) = a(81):
n81 = 9: GoSub 1860: If fl1 = 0 Then Return
b(1) = a(9): b(2) = a(17): b(3) = a(25): b(4) = a(33): b(5) = a(41): b(6) = a(49): b(7) = a(57): b(8) = a(65): b(9) = a(73):
n81 = 9: GoSub 1860: If fl1 = 0 Then Return
Return
1860 fl1 = 1
For j1 = 1 To n81
b20 = b(j1)
For j2 = (1 + j1) To n81
If b20 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 81
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 82).Value = n9
Cells(1, 83).Value = n9
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 10: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 10
End If
'' Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)
i3 = 0
For i1 = 1 To 9
For i2 = 1 To 9
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
1500 fl1 = 1
' Transpose a()
i3 = 0: Erase a0
For i1 = 1 To 9
For i2 = 1 To 9
i3 = i3 + 1
a0(i1, i2) = a(i3)
Next i2
Next i1
i3 = 0:
For i1 = 1 To 9
For i2 = 1 To 9
i3 = i3 + 1
b2(i3) = a0(i2, i1)
Next i2
Next i1
' Calculate c2()
Erase c2
For i1 = 1 To 81
c2(i1) = 9 * a(i1) + b2(i1) + 1
Next i1
fl1 = 1: n20 = 0
For j1 = 1 To 81
a20 = c2(j1): If a20 = 1 Then GoTo 1510
For j2 = (1 + j1) To 81
If a20 = c2(j2) Then fl1 = 0: Return
Next j2
1510 Next j1
Return
' Miscellaneous Options
' Exclude Associated Magic Squares
1050 fl1 = 1
s(1) = a(1) + a(81): s(11) = a(11) + a(71): s(21) = a(21) + a(61): s(31) = a(31) + a(51):
s(2) = a(2) + a(80): s(12) = a(12) + a(70): s(22) = a(22) + a(60): s(32) = a(32) + a(50):
s(3) = a(3) + a(79): s(13) = a(13) + a(69): s(23) = a(23) + a(59): s(33) = a(33) + a(49):
s(4) = a(4) + a(78): s(14) = a(14) + a(68): s(24) = a(24) + a(58): s(34) = a(34) + a(48):
s(5) = a(5) + a(77): s(15) = a(15) + a(67): s(25) = a(25) + a(57): s(35) = a(35) + a(47):
s(6) = a(6) + a(76): s(16) = a(16) + a(66): s(26) = a(26) + a(56): s(36) = a(36) + a(46):
s(7) = a(7) + a(75): s(17) = a(17) + a(65): s(27) = a(27) + a(55): s(37) = a(37) + a(45):
s(8) = a(8) + a(74): s(18) = a(18) + a(64): s(28) = a(28) + a(54): s(38) = a(38) + a(44):
s(9) = a(9) + a(73): s(19) = a(19) + a(63): s(29) = a(29) + a(53): s(39) = a(39) + a(43):
s(10) = a(10) + a(72): s(20) = a(20) + a(62): s(30) = a(30) + a(52): s(40) = a(40) + a(42):
For i20 = 1 To 40
If s(i20) <> 8 Then fl1 = 0: Exit For
Next i20
Return
' Exclude Compact (3 x 3)
1450 fl1 = 1
'Clmn 1
s(1) = a(1) + a(10) + a(19) + a(2) + a(11) + a(20) + a(3) + a(12) + a(21):
s(2) = a(2) + a(11) + a(20) + a(3) + a(12) + a(21) + a(4) + a(13) + a(22):
s(3) = a(3) + a(12) + a(21) + a(4) + a(13) + a(22) + a(5) + a(14) + a(23):
s(4) = a(4) + a(13) + a(22) + a(5) + a(14) + a(23) + a(6) + a(15) + a(24):
s(5) = a(5) + a(14) + a(23) + a(6) + a(15) + a(24) + a(7) + a(16) + a(25):
s(6) = a(6) + a(15) + a(24) + a(7) + a(16) + a(25) + a(8) + a(17) + a(26):
s(7) = a(7) + a(16) + a(25) + a(8) + a(17) + a(26) + a(9) + a(18) + a(27):
s(8) = a(8) + a(17) + a(26) + a(9) + a(18) + a(27) + a(1) + a(10) + a(19):
s(9) = a(9) + a(18) + a(27) + a(1) + a(10) + a(19) + a(2) + a(11) + a(20):
'Clmn 2
s(10) = a(10) + a(19) + a(28) + a(11) + a(20) + a(29) + a(12) + a(21) + a(30):
s(11) = a(11) + a(20) + a(29) + a(12) + a(21) + a(30) + a(13) + a(22) + a(31):
s(12) = a(12) + a(21) + a(30) + a(13) + a(22) + a(31) + a(14) + a(23) + a(32):
s(13) = a(13) + a(22) + a(31) + a(14) + a(23) + a(32) + a(15) + a(24) + a(33):
s(14) = a(14) + a(23) + a(32) + a(15) + a(24) + a(33) + a(16) + a(25) + a(34):
s(15) = a(15) + a(24) + a(33) + a(16) + a(25) + a(34) + a(17) + a(26) + a(35):
s(16) = a(16) + a(25) + a(34) + a(17) + a(26) + a(35) + a(18) + a(27) + a(36):
s(17) = a(17) + a(26) + a(35) + a(18) + a(27) + a(36) + a(10) + a(19) + a(28):
s(18) = a(18) + a(27) + a(36) + a(10) + a(19) + a(28) + a(11) + a(20) + a(29):
'Clmn 3
s(19) = a(19) + a(28) + a(37) + a(20) + a(29) + a(38) + a(21) + a(30) + a(39):
s(20) = a(20) + a(29) + a(38) + a(21) + a(30) + a(39) + a(22) + a(31) + a(40):
s(21) = a(21) + a(30) + a(39) + a(22) + a(31) + a(40) + a(23) + a(32) + a(41):
s(22) = a(22) + a(31) + a(40) + a(23) + a(32) + a(41) + a(24) + a(33) + a(42):
s(23) = a(23) + a(32) + a(41) + a(24) + a(33) + a(42) + a(25) + a(34) + a(43):
s(24) = a(24) + a(33) + a(42) + a(25) + a(34) + a(43) + a(26) + a(35) + a(44):
s(25) = a(25) + a(34) + a(43) + a(26) + a(35) + a(44) + a(27) + a(36) + a(45):
s(26) = a(26) + a(35) + a(44) + a(27) + a(36) + a(45) + a(19) + a(28) + a(37):
s(27) = a(27) + a(36) + a(45) + a(19) + a(28) + a(37) + a(20) + a(29) + a(38):
'Clmn 4
s(28) = a(28) + a(37) + a(46) + a(29) + a(38) + a(47) + a(30) + a(39) + a(48):
s(29) = a(29) + a(38) + a(47) + a(30) + a(39) + a(48) + a(31) + a(40) + a(49):
s(30) = a(30) + a(39) + a(48) + a(31) + a(40) + a(49) + a(32) + a(41) + a(50):
s(31) = a(31) + a(40) + a(49) + a(32) + a(41) + a(50) + a(33) + a(42) + a(51):
s(32) = a(32) + a(41) + a(50) + a(33) + a(42) + a(51) + a(34) + a(43) + a(52):
s(33) = a(33) + a(42) + a(51) + a(34) + a(43) + a(52) + a(35) + a(44) + a(53):
s(34) = a(34) + a(43) + a(52) + a(35) + a(44) + a(53) + a(36) + a(45) + a(54):
s(35) = a(35) + a(44) + a(53) + a(36) + a(45) + a(54) + a(28) + a(37) + a(46):
s(36) = a(36) + a(45) + a(54) + a(28) + a(37) + a(46) + a(29) + a(38) + a(47):
'Clmn 5
s(37) = a(37) + a(46) + a(55) + a(38) + a(47) + a(56) + a(39) + a(48) + a(57):
s(38) = a(38) + a(47) + a(56) + a(39) + a(48) + a(57) + a(40) + a(49) + a(58):
s(39) = a(39) + a(48) + a(57) + a(40) + a(49) + a(58) + a(41) + a(50) + a(59):
s(40) = a(40) + a(49) + a(58) + a(41) + a(50) + a(59) + a(42) + a(51) + a(60):
s(41) = a(41) + a(50) + a(59) + a(42) + a(51) + a(60) + a(43) + a(52) + a(61):
s(42) = a(42) + a(51) + a(60) + a(43) + a(52) + a(61) + a(44) + a(53) + a(62):
s(43) = a(43) + a(52) + a(61) + a(44) + a(53) + a(62) + a(45) + a(54) + a(63):
s(44) = a(44) + a(53) + a(62) + a(45) + a(54) + a(63) + a(37) + a(46) + a(55):
s(45) = a(45) + a(54) + a(63) + a(37) + a(46) + a(55) + a(38) + a(47) + a(56):
'Clmn 6
s(46) = a(46) + a(55) + a(64) + a(47) + a(56) + a(65) + a(48) + a(57) + a(66):
s(47) = a(47) + a(56) + a(65) + a(48) + a(57) + a(66) + a(49) + a(58) + a(67):
s(48) = a(48) + a(57) + a(66) + a(49) + a(58) + a(67) + a(50) + a(59) + a(68):
s(49) = a(49) + a(58) + a(67) + a(50) + a(59) + a(68) + a(51) + a(60) + a(69):
s(50) = a(50) + a(59) + a(68) + a(51) + a(60) + a(69) + a(52) + a(61) + a(70):
s(51) = a(51) + a(60) + a(69) + a(52) + a(61) + a(70) + a(53) + a(62) + a(71):
s(52) = a(52) + a(61) + a(70) + a(53) + a(62) + a(71) + a(54) + a(63) + a(72):
s(53) = a(53) + a(62) + a(71) + a(54) + a(63) + a(72) + a(46) + a(55) + a(64):
s(54) = a(54) + a(63) + a(72) + a(46) + a(55) + a(64) + a(47) + a(56) + a(65):
'Clmn 7
s(55) = a(55) + a(64) + a(73) + a(56) + a(65) + a(74) + a(57) + a(66) + a(75):
s(56) = a(56) + a(65) + a(74) + a(57) + a(66) + a(75) + a(58) + a(67) + a(76):
s(57) = a(57) + a(66) + a(75) + a(58) + a(67) + a(76) + a(59) + a(68) + a(77):
s(58) = a(58) + a(67) + a(76) + a(59) + a(68) + a(77) + a(60) + a(69) + a(78):
s(59) = a(59) + a(68) + a(77) + a(60) + a(69) + a(78) + a(61) + a(70) + a(79):
s(60) = a(60) + a(69) + a(78) + a(61) + a(70) + a(79) + a(62) + a(71) + a(80):
s(61) = a(61) + a(70) + a(79) + a(62) + a(71) + a(80) + a(63) + a(72) + a(81):
s(62) = a(62) + a(71) + a(80) + a(63) + a(72) + a(81) + a(55) + a(64) + a(73):
s(63) = a(63) + a(72) + a(81) + a(55) + a(64) + a(73) + a(56) + a(65) + a(74):
'Clmn 8
s(64) = a(64) + a(73) + a(1) + a(65) + a(74) + a(2) + a(66) + a(75) + a(3):
s(65) = a(65) + a(74) + a(2) + a(66) + a(75) + a(3) + a(67) + a(76) + a(4):
s(66) = a(66) + a(75) + a(3) + a(67) + a(76) + a(4) + a(68) + a(77) + a(5):
s(67) = a(67) + a(76) + a(4) + a(68) + a(77) + a(5) + a(69) + a(78) + a(6):
s(68) = a(68) + a(77) + a(5) + a(69) + a(78) + a(6) + a(70) + a(79) + a(7):
s(69) = a(69) + a(78) + a(6) + a(70) + a(79) + a(7) + a(71) + a(80) + a(8):
s(70) = a(70) + a(79) + a(7) + a(71) + a(80) + a(8) + a(72) + a(81) + a(9):
s(71) = a(71) + a(80) + a(8) + a(72) + a(81) + a(9) + a(64) + a(73) + a(1):
s(72) = a(72) + a(81) + a(9) + a(64) + a(73) + a(1) + a(65) + a(74) + a(2):
'Clmn 9
s(73) = a(73) + a(1) + a(10) + a(74) + a(2) + a(11) + a(75) + a(3) + a(12):
s(74) = a(74) + a(2) + a(11) + a(75) + a(3) + a(12) + a(76) + a(4) + a(13):
s(75) = a(75) + a(3) + a(12) + a(76) + a(4) + a(13) + a(77) + a(5) + a(14):
s(76) = a(76) + a(4) + a(13) + a(77) + a(5) + a(14) + a(78) + a(6) + a(15):
s(77) = a(77) + a(5) + a(14) + a(78) + a(6) + a(15) + a(79) + a(7) + a(16):
s(78) = a(78) + a(6) + a(15) + a(79) + a(7) + a(16) + a(80) + a(8) + a(17):
s(79) = a(79) + a(7) + a(16) + a(80) + a(8) + a(17) + a(81) + a(9) + a(18):
s(80) = a(80) + a(8) + a(17) + a(81) + a(9) + a(18) + a(73) + a(1) + a(10):
s(81) = a(81) + a(9) + a(18) + a(73) + a(1) + a(10) + a(74) + a(2) + a(11):
For i20 = 1 To 81
If s(i20) <> s1 Then fl1 = 0: Exit For
Next i20
Return
End Sub
