About the Author

' Constructs Generators with 3 Magic Rows s5 = 35
' Converts    Generators to       Top Lines s5 = 35, s15 = 105

' Tested with Office 365 under Windows 11

Sub CnstrGen3()

Dim a(15), a1(15), a2(15), nRw(5), c(15)

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

Sheets("Klad1").Select

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

ShtNm1 = "MgcLns5"

For j1 = 1 To 43

    n10 = 5: Erase a
    For i1 = 1 To 5
        a1(i1) = Sheets(ShtNm1).Cells(j1, i1).Value
    Next i1
    s2 = Sheets(ShtNm1).Cells(j1, 7).Value
    nRw(1) = j1
    
    For i1 = 1 To 5             'First Line
        a(i1) = a1(i1)
    Next i1
    
For j2 = j1 + 1 To 141
j100 = j2: j101 = 2: GoSub 100: If fl1 = 0 Then GoTo 20
nRw(2) = j2

For j3 = j2 + 1 To 141
j100 = j3: j101 = 3: GoSub 100: If fl1 = 0 Then GoTo 30
nRw(3) = j3
    
    n9 = n9 + 1: GoSub 640      'Print results (lines)
'   n9 = n9 + 1: GoSub 650      'Print results (squares)

''End

   n10 = n10 - 5
30 Next j3
   n10 = n10 - 5
20 Next j2
   n10 = n10 - 5
10 Next j1

End

100 fl1 = 1

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

    For i1 = 1 To 5
    a20 = a2(i1)
    For i2 = 1 To n10
        If a20 = a(i2) Then fl1 = 0: Return
    Next i2
    Next i1
    
    n10 = n10 + 5
    i2 = 0
    For i1 = n10 - 5 + 1 To n10
        i2 = i2 + 1
        a(i1) = a2(i2)
    Next i1

    Return

'   Print Results (lines)

640
    c(1)  = a(1): c(2) =  a(6):  c(3)  = a(11):
    c(4)  = a(2): c(5) =  a(7):  c(6)  = a(12):
    c(7)  = a(3): c(8) =  a(8):  c(9)  = a(13):
    c(10) = a(4): c(11) = a(9):  c(12) = a(14):
    c(13) = a(5): c(14) = a(10): c(15) = a(15):

    For i1 = 1 To 15
        Cells(n9, i1).Value = c(i1)
    Next i1
    Cells(n9, 16).Value = n9

    Return

'   Print Results (Rectangles)

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

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

End Sub

About the Author