﻿ Sudoku Games Generator   ﻿

# 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

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)
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
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

lups = lups + 1
Wend

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

End Sub

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

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)

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)

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)

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
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

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

Thanks this script is super!

It seems to me that this does not produce unique solutions. Does anyone else find that?

Comment made by: Dave M. , 2016-05-10 14:15:22

Thank you for this code ! But do you have the same code only for one grid ?

Comment made by: Audrey F. , 2017-08-06 21:45:02

Excellent coding.

Comment made by: Sai Kyaw Han , 2019-07-31 07:55:32

This does not generate enough hints on difficulty level; there are too few numbers to create a solution. Usually you need at least 17 numbers and these only generate 11 at difficulty level 7.

Comment made by: Jennifer , 2019-11-08 01:57:48

# Write Comment:

 Comment: two + 3 minus 1= Your name: