About the Author

' Base Generators, Based on Bimagic Series with Odd Numbers

' Tested with Office 365 under Windows 10

Sub BaseGen7()

Dim a(7, 7), a1(7), a2(7)

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

    k1 = 1: k2 = 1: n9 = 0
    ShtNm1 = "OddLns7"

'   Select Odd Series

    Sheets("Klad1").Select

    For j10 = 2 To 61
        
    For i1 = 1 To 7:
         a1(i1) = Sheets(ShtNm1).Cells(j10, i1).Value:
    Next i1
    
    For j20 = j10 + 1 To 61

    For i1 = 1 To 7:
        a2(i1) = Sheets(ShtNm1).Cells(j20, i1).Value:
    Next i1

'   Check and rearrange Odd Series

    GoSub 500: If fl1 = 0 Then GoTo 200

    a(1, 1) = Sheets(ShtNm1).Cells(j20, 1).Value
    For i1 = 1 To 7
        a(1, i1) = a1(i1)
    Next i1

    For i1 = 1 To 7
        a(i1, 1) = a2(i1)
    Next i1

    n9 = n9 + 1: GoSub 640  'Lines
''  n9 = n9 + 1: GoSub 650  'Squares

200 Next j20
100 Next j10

End

'   Check Odd Series

500 fl1 = 1

    n12 = 0
    For i1 = 1 To 7
    For i2 = 1 To 7
        If a1(i1) = a2(i2) Then
            n12 = n12 + 1
            i3 = i1
            i4 = i2
        End If
    Next i2
    Next i1
    
    If n12 <> 1 Then fl1 = 0: Return    'Wrong
    
    If i3 = 1 And i4 = 1 Then Return    'Good, Correct Sequence
   
    If i3 <> 1 Then                     'Swap a1(1) and a1(i3)
       a12 = a1(i3): a1(i3) = a1(1): a1(1) = a12
    End If
    
    If i4 <> 1 Then                     'Swap a2(1) and a2(i4)
       a12 = a2(i4): a2(i4) = a2(1): a2(1) = a12
    End If
    
    Return

'   Print Results (Lines)

640 i3 = 0
    For i1 = 1 To 7
    For i2 = 1 To 7
        i3 = i3 + 1
        Cells(n9, i3).Value = a(i1, i2)
    Next i2
    Next i1
        
    Cells(n9, 50).Value = j10
    Cells(n9, 51).Value = j20
    Cells(n9, 52).Value = n9
    
    Return

'   Print Results (Squares)

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

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

End Sub

About the Author