Sudoku Games Generator
Soduko Games Generator is a program that generates Sudoku games with chosen difficulty and complexity levels.
ExplanationThe 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.
The program and excel VBA file is available for downloading at the bottom of this page, enjoy hacking!
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
Download excel file! Sudoku_Games_Generator.xls |
