About the Author

' Constructs Order 10 Generators, Integers 1 ... 100

' Tested with Office 365 under Windows 10

Sub MgcLns10()

Dim a1(100), a(10), b1(100), b(100)

y = MsgBox("Blocked", vbExclamation, "MgcLns10")
End

    Sheets("Klad1").Select
   
    For i1 = 1 To 100
        a1(i1) = i1
    Next i1
    s10 = 505

    For i1 = 1 To 100
        b1(a1(i1)) = a1(i1)
    Next i1

    n10 = 100

'   Block Corner Square (8 x 8), if applicable

    Erase b
    For i1 = 1 To 8
    For i2 = 1 To 8
        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 < 8 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 < 8 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 < 8 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

x = Cells(n9 + 1, 4).Value
If n9 < 8 And x <> 0 Then
    a(4) = x: b(x) = x
Else
    If b(a1(j4)) = a1(j4) Then GoTo 40
    a(4) = a1(j4)
End If

For j5 = j4 + 1 To n10

x = Cells(n9 + 1, 5).Value
If n9 < 8 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 = j5 + 1 To n10

x = Cells(n9 + 1, 6).Value
If n9 < 8 And x <> 0 Then
    a(6) = x: b(x) = x
Else
    If b(a1(j6)) = a1(j6) Then GoTo 60
    a(6) = a1(j6)
End If

For j7 = j6 + 1 To n10

x = Cells(n9 + 1, 7).Value
If n9 < 8 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 = j7 + 1 To n10

x = Cells(n9 + 1, 8).Value
If n9 < 8 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

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 100
If b(a(10)) = a(10) Then GoTo 100
If b1(a(10)) <> a(10) Then GoTo 100

GoSub 500: If fl1 = 0 Then GoTo 100     'Check Identical Numbers

n9 = n9 + 1:
For i1 = 1 To 10
    Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 11).Value = n9

For i1 = 1 To 10
    b(a(i1)) = a(i1)
Next i1

GoTo 10

100
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 < 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

End

'  Check Identical Numbers

500 fl1 = 1

    For i1 = 1 To 10
        a2 = a(i1)
        For i2 = i1 + 1 To 10
            If a(i2) = a2 Then fl1 = 0: Return
            If a(i2) = (101 - a2) Then fl1 = 0: Return  ' Complement Free (Option)
        Next i2
    Next i1

    Return

End Sub

About the Author