Sudoku Games Generator

Soduko Games Generator is a program that generates Sudoku games with chosen difficulty and complexity levels.

Explanation

The program is basically developed and programmed based on the Sudoku Solver (also available here on this site) and the approach is to try to solve a Sudoku without any start values, an empty matrix that is. The program then uses the logic functions and guess functions in order to find a solution for the Sudoku game. You can make sudokus with different difficult levels. Starting with less data makes the sudoku harder to solve but if you enter to few data the result can be that different end solutions can be found all are correct though. Make sure to test the program in the solver and make sure that only one solution can be found before giving the game to friends.

Code

Public Sub Sudoku_Games_Generator()

Range("N3:V11").ClearContents
Range("C3:K11").ClearContents
Range("C14:K22").ClearContents
Range("N14:V22").ClearContents
Range("C25:K33").ClearContents
Range("N25:V33").ClearContents

'The array containing all data
Dim Sudoku_Games_Generator(9, 9, 40)

For lupar2 = 1 To 6
Erase Sudoku_Games_Generator
'Check_Var controls if the program has written anything new to the matrix if not then the guess program is executed
Check_Var = False



Call ReadInData(Sudoku_Games_Generator)

Call ReadyOrNot(Sudoku_Games_Generator)
StartAllOver = 0
lups = 0
ER = False
While ER = False
    For Row = 1 To 9
        For Column = 1 To 9
            If Sudoku_Games_Generator(Row, Column, 0) = tom Then
                Check_Var = False
                'Basic methods for solving Sudoku
                Call CheckQ2(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckR2(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckC2(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckQ2IN(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckR2IN(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call CheckC2IN(Sudoku_Games_Generator, Row, Column, Check_Var)
                Call ReadyOrNot(Sudoku_Games_Generator)
            End If
        Next
    Next
'?!?!

    ReStart = False
    'Searches for errors if the error is found during first run the program ends
    Call CheckError(Sudoku_Games_Generator, ReStart, start)
    If ReStart = True Then
        Check_Var = True
        Erase Sudoku_Games_Generator
        Call ReadInData(Sudoku_Games_Generator)
        StartAllOver = StartAllOver + 1
        If StartAllOver > 1000 Then
            End
        End If
        If lups = 0 Then
            End
        End If
   
    End If

    If Check_Var = False Then
        Call Guess(Sudoku_Games_Generator, Check_Var, StartAllOver)
    End If

    Call ReadyOrNot(Sudoku_Games_Generator)
    Call CheckReady(Sudoku_Games_Generator, ER)
    lups = lups + 1
Wend

Call EraseData(Sudoku_Games_Generator, Range("N1").Value)
Call Check_VarData(Sudoku_Games_Generator, Check_Var, lupar2)
Next

End Sub

Public Sub ReadInData(Sudoku_Games_Generator)

For Row = 1 To 9
    For Column = 1 To 9
        Sudoku_Games_Generator(Row, Column, 11) = tom
        Sudoku_Games_Generator(Row, Column, 0) = tom
        If Sudoku_Games_Generator(Row, Column, 0) = tom Then
            For loops = 1 To 9
                Sudoku_Games_Generator(Row, Column, loops) = 1
            Next
        Else
            For loops = 1 To 9
                Sudoku_Games_Generator(Row, Column, loops) = 0
            Next
        End If

        If Column < 4 Then
            If Row < 4 Then
                Sudoku_Games_Generator(Row, Column, 10) = 1
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Games_Generator(Row, Column, 10) = 4
            End If
            If Row > 6 Then
                Sudoku_Games_Generator(Row, Column, 10) = 7
            End If
        End If

        If Column < 7 And Column > 3 Then
            If Row < 4 Then
                Sudoku_Games_Generator(Row, Column, 10) = 2
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Games_Generator(Row, Column, 10) = 5
            End If
            If Row > 6 Then
                Sudoku_Games_Generator(Row, Column, 10) = 8
            End If
        End If

        If Column > 6 Then
            If Row < 4 Then
                Sudoku_Games_Generator(Row, Column, 10) = 3
            End If
            If Row < 7 And Row > 3 Then
                Sudoku_Games_Generator(Row, Column, 10) = 6
            End If
            If Row > 6 Then
                Sudoku_Games_Generator(Row, Column, 10) = 9
            End If
        End If
    Next
Next

End Sub


Public Sub Check_VarData(Sudoku_Games_Generator, Check_Var, lupar2)

If lupar2 = 1 Then
    RowPos = 0
    ColumnPos = 0
End If

If lupar2 = 2 Then
    RowPos = 0
    ColumnPos = 11
End If

If lupar2 = 3 Then
    RowPos = 11
    ColumnPos = 0
End If

If lupar2 = 4 Then
    RowPos = 11
    ColumnPos = 11
End If

'?!?!

If lupar2 = 5 Then
    RowPos = 22
    ColumnPos = 0
End If

If lupar2 = 6 Then
    RowPos = 22
    ColumnPos = 11
End If

For Row = 1 To 9
    For Column = 1 To 9
        If Range("c3").Offset(RowPos - 1 + Row, ColumnPos - 1 + Column).Value = tom Then
            If Sudoku_Games_Generator(Row, Column, 0) <> tom Then
                Range("c3").Offset(RowPos - 1 + Row, ColumnPos - 1 + Column).Value = Sudoku_Games_Generator(Row, Column, 0)
                Check_Var = True
            End If
        End If
    Next
Next

End Sub

Public Sub ReadyOrNot(Sudoku_Games_Generator)

For Row = 1 To 9
    For Column = 1 To 9
        For värde = 1 To 9
            If Sudoku_Games_Generator(Row, Column, värde) = 1 Then
                antal = antal + 1
                värdeTal = värde
            End If
        Next
        If antal = 1 Then
            Sudoku_Games_Generator(Row, Column, värdeTal) = 0
            Sudoku_Games_Generator(Row, Column, 0) = värdeTal
        End If
        antal = 0
    Next
Next

End Sub


Public Sub CheckQ2(Sudoku_Games_Generator, Row, Column, Check_Var)

kvadrant = Sudoku_Games_Generator(Row, Column, 10)

For RowT = 1 To 9
    For ColumnT = 1 To 9
        If Sudoku_Games_Generator(RowT, ColumnT, 10) = kvadrant Then
            If Sudoku_Games_Generator(RowT, ColumnT, 0) <> tom Then
                tal = Sudoku_Games_Generator(RowT, ColumnT, 0)
            If Sudoku_Games_Generator(Row, Column, tal) = 1 Then
                Sudoku_Games_Generator(Row, Column, tal) = 0
                Check_Var = True
            End If
            End If
        End If
    Next
Next

End Sub


Public Sub CheckR2(Sudoku_Games_Generator, Row, Column, Check_Var)

For ColumnT = 1 To 9
    If Sudoku_Games_Generator(Row, ColumnT, 0) <> tom Then
        värdeTal = Sudoku_Games_Generator(Row, ColumnT, 0)
        If Sudoku_Games_Generator(Row, Column, värdeTal) = 1 Then
            Sudoku_Games_Generator(Row, Column, värdeTal) = 0
            Check_Var = True
        End If
    End If
Next

End Sub

Public Sub CheckC2(Sudoku_Games_Generator, Row, Column, Check_Var)

For RowT = 1 To 9
    If Sudoku_Games_Generator(RowT, Column, 0) <> tom Then
        värdeTal = Sudoku_Games_Generator(RowT, Column, 0)
        If Sudoku_Games_Generator(Row, Column, värdeTal) = 1 Then
            Sudoku_Games_Generator(Row, Column, värdeTal) = 0
            Check_Var = True
        End If
    End If
Next

End Sub



Public Sub CheckQ2IN(Sudoku_Games_Generator, Row, Column, Check_Var)

kvadrant = Sudoku_Games_Generator(Row, Column, 10)

For värde = 1 To 9
    unik = True
    If Sudoku_Games_Generator(Row, Column, värde) = 1 Then
        For RowT = 1 To 9
            For ColumnT = 1 To 9
                If Sudoku_Games_Generator(RowT, ColumnT, 10) = kvadrant Then
                    If Sudoku_Games_Generator(RowT, ColumnT, 0) = värde Then unik = False
                    If Sudoku_Games_Generator(RowT, ColumnT, värde) = 1 Then
                        If Row = RowT And Column = ColumnT Then
                        Else
                            unik = False
                        End If
                    End If
                End If
            Next
        Next

        If unik = True Then
            Sudoku_Games_Generator(Row, Column, 0) = värde
            Check_Var = True
            For lups = 1 To 9
                Sudoku_Games_Generator(Row, Column, lups) = 0
            Next
        End If
  End If
Next

End Sub
'?!?!
Public Sub CheckR2IN(Sudoku_Games_Generator, Row, Column, Check_Var)

For värde = 1 To 9
    unik = True
    If Sudoku_Games_Generator(Row, Column, värde) = 1 Then
        For ColumnT = 1 To 9
            If Sudoku_Games_Generator(Row, ColumnT, 0) = värde Then
                unik = False
            End If
            If Sudoku_Games_Generator(Row, ColumnT, värde) = 1 Then
                If ColumnT <> Column Then
                    unik = False
                End If
            End If
        Next
        If unik = True Then
            Sudoku_Games_Generator(Row, Column, 0) = värde
            Check_Var = True
            For lups = 1 To 9
                Sudoku_Games_Generator(Row, Column, lups) = 0
            Next
        End If
    End If
Next

End Sub

Public Sub CheckC2IN(Sudoku_Games_Generator, Row, Column, Check_Var)

kvadrant = Sudoku_Games_Generator(Row, Column, 10)

For värde = 1 To 9
    unik = True
    If Sudoku_Games_Generator(Row, Column, värde) = 1 Then
        For RowT = 1 To 9
            If Sudoku_Games_Generator(RowT, Column, 0) = värde Then
                unik = False
            End If
            If Sudoku_Games_Generator(RowT, Column, värde) = 1 Then
                If RowT <> Row Then
                    unik = False
                End If
            End If
        Next
        If unik = True Then



            Sudoku_Games_Generator(Row, Column, 0) = värde
            Check_Var = True
            For lups = 1 To 9
                Sudoku_Games_Generator(Row, Column, lups) = 0
            Next
        End If
    End If
Next

End Sub

Public Sub Guess(Sudoku_Games_Generator, Check_Var, StartAllOver)

'identify best guess place

SlutSumma = 10
For Row = 1 To 9
    For Column = 1 To 9
        If Sudoku_Games_Generator(Row, Column, 0) = tom Then
            For lups = 1 To 9
                summa = summa + Sudoku_Games_Generator(Row, Column, lups)
            Next
            If summa < SlutSumma Then
                SlutRow = Row
                SlutColumn = Column
                SlutSumma = summa
            End If
            summa = 0
        End If
    Next
Next
'?!?!
If SlutSumma <> 0 Then
    'Random number between 1 and 9
    hittat = False
    While hittat = False
        Randomize
        tal = Int((9 * Rnd) + 1)
        If Sudoku_Games_Generator(SlutRow, SlutColumn, tal) = 1 Then
            hittat = True
            Sudoku_Games_Generator(SlutRow, SlutColumn, 0) = tal
            For lups = 1 To 9
                Sudoku_Games_Generator(SlutRow, SlutColumn, lups) = 0
                Check_Var = True
            Next
        End If
    Wend
Else
    Erase Sudoku_Games_Generator
    Check_Var = True
    Call ReadInData(Sudoku_Games_Generator)
    StartAllOver = StartAllOver + 1
    If StartAllOver > 1000 Then
        End
    End If
End If

End Sub

Public Sub CheckError(Sudoku_Games_Generator, ReStart, start)

Dim R(9)
Dim C(9)

For Value = 1 To 9
    For Row = 1 To 9
        Erase R
        For Column = 1 To 9
            If Sudoku_Games_Generator(Row, Column, 0) <> 0 Then
                R(Sudoku_Games_Generator(Row, Column, 0)) = R(Sudoku_Games_Generator(Row, Column, 0)) + 1
                If R(Sudoku_Games_Generator(Row, Column, 0)) > 1 Then ReStart = True
            End If
        Next
    Next
    For Column2 = 1 To 9
        Erase C
        For Row2 = 1 To 9
            If Sudoku_Games_Generator(Row2, Column2, 0) <> 0 Then
                C(Sudoku_Games_Generator(Row2, Column2, 0)) = C(Sudoku_Games_Generator(Row2, Column2, 0)) + 1
                If C(Sudoku_Games_Generator(Row2, Column2, 0)) > 1 Then ReStart = True
            End If
        Next
    Next
Next

End Sub



Public Sub CheckReady(Sudoku_Games_Generator, ER)

For Row = 1 To 9
    For Column = 1 To 9
        Summan = Summan + Sudoku_Games_Generator(Row, Column, 0)
        If Sudoku_Games_Generator(Row, Column, 0) <> tom Then
            Summan2 = Summan2 + 1
        End If
    Next
Next

If Summan = 405 And Summan2 = 81 Then
    ER = True
End If

End Sub

Public Sub EraseData(Sudoku_Games_Generator, EraseNumber)

While rounds <> (EraseNumber * 10)
    Randomize
    Row = Int((9 * Rnd) + 1)
    Randomize
    Column = Int((9 * Rnd) + 1)
    If Sudoku_Games_Generator(Row, Column, 0) <> tom Then
        Sudoku_Games_Generator(Row, Column, 0) = tom
        rounds = rounds + 1
    End If
Wend

End Sub