' Constructs Generators with 4 Magic Rows, Magic Sums s4(i), i = 1 ... 4
' Tested with Office 365 under Windows 11
Sub CnstrGen4()
Dim a(16), a1(16), a2(16), s4(5), c(16)
y = MsgBox("Blocked", vbInformation, "CnstrGen4")
End
Sheets("Klad1").Select
n2 = 0: k1 = 1: k2 = 1
ShtNm1 = "MgcLns4"
For j1 = 2 To 50
n10 = 4: Erase a
For i1 = 1 To 4
a1(i1) = Sheets(ShtNm1).Cells(j1, i1).Value
Next i1
s4(1) = Sheets(ShtNm1).Cells(j1, 5).Value
For i1 = 1 To 4 'First Line
a(i1) = a1(i1)
Next i1
For j2 = j1 + 1 To 253
j100 = j2: j101 = 2: GoSub 100: If fl1 = 0 Then GoTo 20
For j3 = j2 + 1 To 253
j100 = j3: j101 = 3: GoSub 100: If fl1 = 0 Then GoTo 30
For j4 = j3 + 1 To 253
j100 = j4: j101 = 4: GoSub 100: If fl1 = 0 Then GoTo 40
' n9 = n9 + 1: GoSub 640 'Print results (lines)
n9 = n9 + 1: GoSub 650 'Print results (squares)
n10 = n10 - 4
40 Next j4
n10 = n10 - 4
30 Next j3
n10 = n10 - 4
20 Next j2
n10 = n10 - 4
10 Next j1
End
100 fl1 = 1
For i1 = 1 To 4
a2(i1) = Sheets(ShtNm1).Cells(j100, i1).Value
Next i1
s4(j101) = Sheets(ShtNm1).Cells(j100, 5).Value
For i1 = 1 To 4
a20 = a2(i1)
For i2 = 1 To n10
If a20 = a(i2) Then fl1 = 0: Return
Next i2
Next i1
n10 = n10 + 4
i2 = 0
For i1 = n10 - 4 + 1 To n10
i2 = i2 + 1
a(i1) = a2(i2)
Next i1
Return
' Print Results (lines)
640
For i1 = 1 To 16
Cells(n9, i1).Value = a(i1)
Next i1
For i1 = 1 To 4
Cells(n9, i1 + 16).Value = s4(i1)
Next i1
Cells(n9, 22).Value = n9 - 1
Cells(1, 24).Value = n9 - 1
Return
' Print Results (Squares)
650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 5: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 5
End If
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
End Sub