About the Author

' Generates Generators for Bimagic Squares, Victor Coccoz

' Tested with Office 2007 under Windows 7

Sub CnstrGen01()

Dim a(64), a1(64), a2(64), Grp0(8), nGrp(5)

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

Sheets("Klad1").Select

n1 = 0: n9 = 0: k1 = 1: k2 = 1
s1 = 260: s2 = 11180

n0 = 1: n8 = 96

' Define Group Numbers

GrpNr1 = 1: GrpNr2 = 4

For j1 = n0 To n8

n10 = 8: Erase a
For i1 = 1 To 8
    a1(i1) = Sheets("Coccoz8").Cells(j1, i1).Value
Next i1
Grp0(1) = Sheets("Coccoz8").Cells(j1, 9).Value

For i1 = 1 To 8   'First Line
    a(i1) = a1(i1)
Next i1

For j2 = j1 + 1 To n8
j100 = j2: j101 = 2: GoSub 100: If fl1 = 0 Then GoTo 20

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

For j4 = j3 + 1 To n8
j100 = j4: j101 = 4: GoSub 100: If fl1 = 0 Then GoTo 40

For j5 = j4 + 1 To n8
j100 = j5: j101 = 5: GoSub 100: If fl1 = 0 Then GoTo 50

For j6 = j5 + 1 To n8
j100 = j6: j101 = 6: GoSub 100: If fl1 = 0 Then GoTo 60

For j7 = j6 + 1 To n8
j100 = j7: j101 = 7: GoSub 100: If fl1 = 0 Then GoTo 70

For j8 = j7 + 1 To n8
j100 = j8: j101 = 8: GoSub 100: If fl1 = 0 Then GoTo 80


    Erase nGrp
    For i1 = 1 To 8
        Grp1 = Grp0(i1)
        nGrp(Grp1) = nGrp(Grp1) + 1
    Next i1

    If nGrp(GrpNr1) <> 4 Or nGrp(GrpNr2) <> 4 Then GoTo 5

    n9 = n9 + 1: GoSub 650  'Print results (squares)

5

   n10 = n10 - 8
80 Next j8
   n10 = n10 - 8
70 Next j7
   n10 = n10 - 8
60 Next j6
   n10 = n10 - 8
50 Next j5
   n10 = n10 - 8
40 Next j4
   n10 = n10 - 8
30 Next j3
   n10 = n10 - 8
20 Next j2
   n10 = n10 - 8
10 Next j1

End

100 fl1 = 1

    For i1 = 1 To 8
        a2(i1) = Sheets("Coccoz8").Cells(j100, i1).Value
    Next i1
    Grp0(j101) = Sheets("Coccoz8").Cells(j100, 9).Value

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

Return

'   Print Results (Squares)

650 n2 = n2 + 1
    If n2 = 5 Then
        n2 = 1: k1 = k1 + 9: k2 = 1
    Else
        If n9 > 1 Then k2 = k2 + 9
    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 8
        For i2 = 1 To 8
            i3 = i3 + 1
            Cells(k1 + i1, k2 + i2).Value = a(i3)
        Next i2
        Cells(k1 + i1, k2 + 9).Value = Grp0(i1)
    Next i1

    Return

End Sub

About the Author