' Constructs Order 14 Generators, Integers 1 ... 196
' Tested with Office 365 under Windows 10
Sub MgcLns14()
Dim a1(196), a(14), b1(196), b(196)
y = MsgBox("Blocked", vbExclamation, "MgcLns14")
End
Sheets("Klad1").Select
Clmn14 = 1 'Column Number
For i1 = 1 To 196
a1(i1) = Sheets("Ranges14").Cells(i1 + 1, Clmn14).Value
Next i1
s14 = Sheets("Ranges14").Cells(1, Clmn14).Value
For i1 = 1 To 196
b1(a1(i1)) = a1(i1)
Next i1
n14 = 196
Erase b
' Block Corner Square (8 x 8), if applicable
For i1 = 1 To 9
For i2 = 1 To 9
x = Cells(i1, i2).Value
b(x) = x
Next i2
Next i1
For j1 = 1 To n14
x = Cells(n9 + 1, 1).Value
If n9 < 9 And x <> 0 Then
a(1) = x: b(x) = x
Else
If b(a1(j1)) = a1(j1) Then GoTo 10
a(1) = a1(j1)
End If
For j2 = n14 To j1 + 1 Step -1
x = Cells(n9 + 1, 2).Value
If n9 < 9 And x <> 0 Then
a(2) = x: b(x) = x
Else
If b(a1(j2)) = a1(j2) Then GoTo 20
a(2) = a1(j2)
End If
For j3 = j1 + 1 To n14
x = Cells(n9 + 1, 3).Value
If n9 < 9 And x <> 0 Then
a(3) = x: b(x) = x
Else
If b(a1(j3)) = a1(j3) Then GoTo 30
a(3) = a1(j3)
End If
For j4 = n14 To j3 + 1 Step -1
x = Cells(n9 + 1, 4).Value
If n9 < 9 And x <> 0 Then
a(4) = x: b(x) = x
Else
If b(a1(j4)) = a1(j4) Then GoTo 40
a(4) = a1(j4)
If a(4) = a(2) Then GoTo 40
End If
For j5 = j3 + 1 To n14
x = Cells(n9 + 1, 5).Value
If n9 < 9 And x <> 0 Then
a(5) = x: b(x) = x
Else
If b(a1(j5)) = a1(j5) Then GoTo 50
a(5) = a1(j5)
End If
For j6 = n14 To j5 + 1 Step -1
x = Cells(n9 + 1, 6).Value
If n9 < 9 And x <> 0 Then
a(6) = x: b(x) = x
Else
If b(a1(j6)) = a1(j6) Then GoTo 60
a(6) = a1(j6)
If a(6) = a(2) Or a(6) = a(4) Then GoTo 60
End If
For j7 = j5 + 1 To n14
x = Cells(n9 + 1, 7).Value
If n9 < 9 And x <> 0 Then
a(7) = x: b(x) = x
Else
If b(a1(j7)) = a1(j7) Then GoTo 70
a(7) = a1(j7)
End If
For j8 = n14 To j7 + 1 Step -1
x = Cells(n9 + 1, 8).Value
If n9 < 9 And x <> 0 Then
a(8) = x: b(x) = x
Else
If b(a1(j8)) = a1(j8) Then GoTo 80
a(8) = a1(j8)
End If
If a(8) = a(2) Or a(8) = a(4) Or a(8) = a(6) Then GoTo 80
For j9 = j7 + 1 To n14
x = Cells(n9 + 1, 9).Value
If n9 < 9 And x <> 0 Then
a(9) = x: b(x) = x
Else
If b(a1(j9)) = a1(j9) Then GoTo 90
a(9) = a1(j9)
End If
For j10 = n14 To j9 + 1 Step -1
If b(a1(j10)) = a1(j10) Then GoTo 100
a(10) = a1(j10)
If a(10) = a(2) Or a(10) = a(4) Or a(10) = a(6) Or a(10) = a(8) Then GoTo 100
For j11 = j9 + 1 To n14
If b(a1(j11)) = a1(j11) Then GoTo 110
a(11) = a1(j11)
For j12 = n14 To j11 + 1 Step -1
If b(a1(j12)) = a1(j12) Then GoTo 120
a(12) = a1(j12)
For j13 = j10 + 1 To n14
If b(a1(j13)) = a1(j13) Then GoTo 130
a(13) = a1(j13)
a(14) = s14 - a(1) - a(2) - a(3) - a(4) - a(5) - a(6) - a(7) - a(8) - a(9) - a(10) - a(11) - a(12) - a(13)
If a(14) < a1(1) Or a(14) > a1(196) Then GoTo 130
If b(a(14)) = a(14) Then GoTo 130
If b1(a(14)) <> a(14) Then GoTo 130
GoSub 500: If fl1 = 0 Then GoTo 130 'Check Identical Numbers
n9 = n9 + 1:
For i1 = 1 To 14
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 15).Value = n9
'' Cells(n9, 16).Value = n14
For i1 = 1 To 14
b(a(i1)) = a(i1)
Next i1
GoTo 10
End
130 Next j13
120 Next j12
110 Next j11
100 Next j10
90 Next j9
80 Next j8
70 Next j7
60 Next j6
50 Next j5
40 Next j4
30 Next j3
20 Next j2
10 Next j1
' Print Remainder (If applicable)
If n9 < 14 Then
''y = MsgBox(CStr(n9), 0, "Test")
i2 = 0
For i1 = 1 To 196
i3 = a1(i1)
If b(i3) = 0 Then
i2 = i2 + 1
Cells(n9 + 1, i2).Value = i3
End If
Next i1
End If
End
' Check Line
500 fl1 = 1
For i1 = 1 To 14
a2 = a(i1)
For i2 = i1 + 1 To 14
If a(i2) = a2 Then fl1 = 0: Return
Next i2
Next i1
Return
End Sub
