' Constructs Order 10 Generators, Consecutive Prime Numbers
' Order 3 Square Inlays
' Tested with Office 365 under Windows 10
Sub MgcLns10b()
Dim a1(100), a(10), b1(1500), b(1500)
y = MsgBox("Blocked", vbExclamation, "MgcLns10b")
End
Sheets("Klad1").Select
For i1 = 1 To 100
a1(i1) = Sheets("Ranges10").Cells(i1 + 1, 3).Value
Next i1
s10 = Sheets("Ranges10").Cells(1, 3).Value
For i1 = 1 To 100
b1(a1(i1)) = a1(i1)
Next i1
n10 = 100
Erase b
' Block Corner Square (3 x 3)
For i1 = 1 To 3
For i2 = 1 To 3
x = Cells(i1, i2).Value
b(x) = x
Next i2
Next i1
For j1 = 1 To n10
x = Cells(n9 + 1, 1).Value
If n9 < 3 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 = j1 + 1 To n10
x = Cells(n9 + 1, 2).Value
If n9 < 3 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 = j2 + 1 To n10
x = Cells(n9 + 1, 3).Value
If n9 < 3 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 = j3 + 1 To n10
If b(a1(j4)) = a1(j4) Then GoTo 40
a(4) = a1(j4)
For j5 = j4 + 1 To n10
If b(a1(j5)) = a1(j5) Then GoTo 50
a(5) = a1(j5)
For j6 = j5 + 1 To n10
If b(a1(j6)) = a1(j6) Then GoTo 60
a(6) = a1(j6)
For j7 = j6 + 1 To n10
If b(a1(j7)) = a1(j7) Then GoTo 70
a(7) = a1(j7)
For j8 = j7 + 1 To n10
If b(a1(j8)) = a1(j8) Then GoTo 80
a(8) = a1(j8)
For j9 = j8 + 1 To n10
If b(a1(j9)) = a1(j9) Then GoTo 90
a(9) = a1(j9)
a(10) = s10 - a(1) - a(2) - a(3) - a(4) - a(5) - a(6) - a(7) - a(8) - a(9)
If a(10) < a1(1) Or a(10) > a1(100) Then GoTo 90
If b(a(10)) = a(10) Then GoTo 90
If b1(a(10)) <> a(10) Then GoTo 90
If a(10) <= a(9) Then GoTo 90
n9 = n9 + 1:
For i1 = 1 To 10
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 11).Value = n9
Cells(n9, 12).Value = s10
For i1 = 1 To 10
b(a(i1)) = a(i1)
Next i1
GoTo 10
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 n9 < 10 Then
i2 = 0
For i1 = 1 To 100
i3 = a1(i1)
If b(i3) = 0 Then
i2 = i2 + 1
Cells(n9 + 1, i2).Value = i3
End If
Next i1
End If
y = MsgBox(CStr(n9) + " Lines", vbInformation, "MgcLns10b")
End Sub