About the Author

' Constructs Generators for Squares of Subtraction (11 x 11)

' Tested with Office 365 under Windows 10

Sub CnstrGen11()

Dim a(121), a1(121), a2(121), nRw(11), b(121)

y = MsgBox("Blocked", vbInformation, "CnstrGen11")
End

Sheets("Klad1").Select

n1 = 0: n9 = 0: k1 = 1: k2 = 1

n0 = 557: n8 = 30396: n81 = 2494
ShtNm1 = "AntSym11"

For j1 = n0 To n81

t11 = Timer                                                   'Time Out

    n10 = 11: Erase a
    For i1 = 1 To 11
        a1(i1) = Sheets(ShtNm1).Cells(j1, i1).Value
    Next i1
    nRw(1) = j1
    
    For i1 = 1 To 11             'First Line
        a(i1) = a1(i1)
    Next i1
    
    GoSub 200                   'Remainder of Lines
    If fl2 = 0 Then GoTo 10     'Not Found, Try Next
  
'   Add Complementairy Rows

    For i1 = 56 To 110
        a(i1) = 122 - a(i1 - 55)
    Next i1
   
'   Complete Generator (Last Row)

    Erase b
    For i1 = 1 To 110
        b(a(i1)) = a(i1)
    Next i1
    
    i2 = 110
    For i1 = 1 To 121
        If b(i1) = 0 Then
            i2 = i2 + 1: a(i2) = i1
        End If
    Next i1
    
   n9 = n9 + 1: GoSub 650      'Print results (Squares)
'' n9 = n9 + 1: GoSub 655      'Print results (Lines)

''End

   n10 = n10 - 11
10 Next j1

End

200 fl2 = 0

For j2 = n81 + 1 To n8
j100 = j2: j101 = 2: GoSub 100: If fl1 = 0 Then GoTo 20
nRw(2) = j2

t12 = Timer: t13 = t12 - t11                                  'Time Out
If t13 > 60 Then Return                                       'Time Out, Try Next

For j3 = j2 + 1 To n8
j100 = j3: j101 = 3: GoSub 100: If fl1 = 0 Then GoTo 30
nRw(3) = j3

t12 = Timer: t13 = t12 - t11                                  'Time Out
If t13 > 60 Then Return                                       'Time Out, Try Next

For j4 = j3 + 1 To n8
j100 = j4: j101 = 4: GoSub 100: If fl1 = 0 Then GoTo 40
nRw(4) = j4
   
t12 = Timer: t13 = t12 - t11                                  'Time Out
If t13 > 60 Then Return                                       'Time Out, Try Next
   
For j5 = j4 + 1 To n8
j100 = j5: j101 = 5: GoSub 100: If fl1 = 0 Then GoTo 50
nRw(5) = j5
   
t12 = Timer: t13 = t12 - t11                                  'Time Out
If t13 > 60 Then Return                                       'Time Out, Try Next
   
   fl2 = 1
   Return

   n10 = n10 - 11
50 Next j5
   n10 = n10 - 11
40 Next j4
   n10 = n10 - 11
30 Next j3
   n10 = n10 - 11
20 Next j2

    Return

100 fl1 = 1

    For i1 = 1 To 11
        a2(i1) = Sheets(ShtNm1).Cells(j100, i1).Value
    Next i1

    For i1 = 1 To 11
    a20 = a2(i1)
    For i2 = 1 To n10
        If a20 = a(i2) Then fl1 = 0: Return
        If a20 = 122 - a(i2) Then fl1 = 0: Return    'Check Complement
    Next i2
    Next i1
    
    n10 = n10 + 11
    i2 = 0
    For i1 = n10 - 11 + 1 To n10
        i2 = i2 + 1
        a(i1) = a2(i2)
    Next i1

Return

'   Print Results (lines)

655 For i1 = 1 To 121
        Cells(n9, i1).Value = a(i1)
    Next i1
    Cells(n9, 122).Value = n9
    Cells(1, 123).Value = n9
    Return

'   Print Results (Squares)

650 n2 = n2 + 1
    If n2 = 4 Then
        n2 = 1: k1 = k1 + 12: k2 = 1
    Else
        If n9 > 1 Then k2 = k2 + 12
    End If

''  Cells(k1, k2 + 1).Select
    Cells(k1, k2 + 1).Font.Color = -4165632
    Cells(k1, k2 + 1).Value = n9
    
    i3 = 0
    For i1 = 1 To 11
        For i2 = 1 To 11
            i3 = i3 + 1
            Cells(k1 + i1, k2 + i2).Value = a(i3)
        Next i2

'       Row Number
        Cells(k1 + i1, k2 + 12).Value = nRw(i1)
        
    Next i1
   
    Return

End Sub

About the Author