﻿ Sudoku Solver

﻿

# Sudoku Solver

A professional tool to be able to solve complex sudoku games. The VBA program uses logic and guess functions to solve the game.

## Explanation

Sudoku solver uses basic logic functions and by this approach eliminates possible numbers in certain positions. For complex games it also has a guess function and loops through different solutions until the correct one is found. This sudoku solver will solve all sudokus also the impossible ones or the ones where only one figure is to start with. When starting with a very low number of data the outcome can vary and the program will find different end solutions. In some cases the program tries an approach that fails then the program starts again and finally the right solution is found. The program can be optimized in speed if the visual effects is turned off before executing the program.

## Code

Public Sub Sudoku_Solver_One()
'Start program to solve one step
Total = False
Call Sudoku_Solver(Total)
End Sub
Public Sub Sudoku_Solver_Total()
'Start program to solve complete
Total = True
Call Sudoku_Solver(Total)
End Sub

Public Sub Sudoku_Solver(Total)

Range("N3:V11").ClearContents
Range("N3:V11").Interior.ColorIndex = 0

'write_it controls if the program has written anything new to the matrix if not then the guess program is executed
write_it = False

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

Call write_itData(Sudoku_Solver, write_it)

lups = 0
ER = False
While ER = False
For Row = 1 To 9
For Column = 1 To 9
If Sudoku_Solver(Row, Column, 0) = tom Then
write_it = False
'Basic methods for solving Sudoku
Call RowCheck(Sudoku_Solver, Row, Column, write_it)
Call ColumnCheck(Sudoku_Solver, Row, Column, write_it)
Call RowCheckIN(Sudoku_Solver, Row, Column, write_it)
Call ColumnCheckIN(Sudoku_Solver, Row, Column, write_it)
End If
Next
Next

'?!?!

ReStart = False
'Searches for errors if the error is found during first run the program ends
Call CheckError(Sudoku_Solver, ReStart, start)
If ReStart = True Then
write_it = True
Erase Sudoku_Solver
Range("N3:V11").ClearContents
Call write_itData(Sudoku_Solver, write_it)
StartAllOver = StartAllOver + 1
If StartAllOver > 1000 Then
End
End If
If lups = 0 Then
End
End If

End If

If write_it = False Then
Call Guess(Sudoku_Solver, write_it, StartAllOver)
End If

If Total = True Then
Call write_itData(Sudoku_Solver, write_it)
End If
lups = lups + 1
Wend

If Total = False Then
Call WriteOne(Sudoku_Solver)
End If

End Sub

For Row = 1 To 9
For Column = 1 To 9
Sudoku_Solver(Row, Column, 11) = Range("c3").Offset(Row - 1, Column - 1).Value
Sudoku_Solver(Row, Column, 0) = Range("c3").Offset(Row - 1, Column - 1).Value
If Sudoku_Solver(Row, Column, 0) = tom Then
For loops = 1 To 9
Sudoku_Solver(Row, Column, loops) = 1
Next
Else
For loops = 1 To 9
Sudoku_Solver(Row, Column, loops) = 0
Next
End If

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

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

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

End Sub

Public Sub write_itData(Sudoku_Solver, write_it)

For Row = 1 To 9
For Column = 1 To 9
If Range("n3").Offset(Row - 1, Column - 1).Value = tom Then
If Sudoku_Solver(Row, Column, 0) <> tom Then
Range("n3").Offset(Row - 1, Column - 1).Value = Sudoku_Solver(Row, Column, 0)
write_it = 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_Solver(Row, Column, värde) = 1 Then
antal = antal + 1
värdeTal = värde
End If
Next
If antal = 1 Then
Sudoku_Solver(Row, Column, värdeTal) = 0
Sudoku_Solver(Row, Column, 0) = värdeTal
End If
antal = 0
Next
Next

End Sub

'?!?!

Public Sub QuadrantCheck(Sudoku_Solver, Row, Column, write_it)

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

End Sub

Public Sub RowCheck(Sudoku_Solver, Row, Column, write_it)

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

End Sub

Public Sub ColumnCheck(Sudoku_Solver, Row, Column, write_it)

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

End Sub

Public Sub QuadrantCheckIN(Sudoku_Solver, Row, Column, write_it)

For värde = 1 To 9
unik = True
If Sudoku_Solver(Row, Column, värde) = 1 Then
For RowT = 1 To 9
For ColumnT = 1 To 9
If Sudoku_Solver(RowT, ColumnT, 10) = kvadrant Then
If Sudoku_Solver(RowT, ColumnT, 0) = värde Then unik = False
If Sudoku_Solver(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_Solver(Row, Column, 0) = värde
write_it = True
For lups = 1 To 9
Sudoku_Solver(Row, Column, lups) = 0
Next
End If
End If
Next

End Sub

Public Sub RowCheckIN(Sudoku_Solver, Row, Column, write_it)

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

End Sub

'?!?!

Public Sub ColumnCheckIN(Sudoku_Solver, Row, Column, write_it)

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

End Sub

Public Sub Guess(Sudoku_Solver, write_it, StartAllOver)

'identify best guess place

SlutSumma = 10
For Row = 1 To 9
For Column = 1 To 9
If Sudoku_Solver(Row, Column, 0) = tom Then
For lups = 1 To 9
summa = summa + Sudoku_Solver(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_Solver(SlutRow, SlutColumn, tal) = 1 Then
hittat = True
Sudoku_Solver(SlutRow, SlutColumn, 0) = tal
For lups = 1 To 9
Sudoku_Solver(SlutRow, SlutColumn, lups) = 0
write_it = True
Next
End If
Wend
Else
Erase Sudoku_Solver
write_it = True
Range("N3:V11").ClearContents
Call write_itData(Sudoku_Solver, write_it)
StartAllOver = StartAllOver + 1
If StartAllOver > 1000 Then
End
End If
End If

'?!?!

End Sub

Public Sub CheckError(Sudoku_Solver, 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_Solver(Row, Column, 0) <> 0 Then
R(Sudoku_Solver(Row, Column, 0)) = R(Sudoku_Solver(Row, Column, 0)) + 1
If R(Sudoku_Solver(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_Solver(Row2, Column2, 0) <> 0 Then
C(Sudoku_Solver(Row2, Column2, 0)) = C(Sudoku_Solver(Row2, Column2, 0)) + 1
If C(Sudoku_Solver(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_Solver(Row, Column, 0)
If Sudoku_Solver(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 WriteOne(Sudoku_Solver)

OneRandom = False
While OneRandom = False
Randomize
Row = Int((9 * Rnd) + 1)
Column = Int((9 * Rnd) + 1)
If Sudoku_Solver(Row, Column, 11) = tom Then
Range("n3").Offset(Row - 1, Column - 1).Value = Sudoku_Solver(Row, Column, 0)
Range("n3").Offset(Row - 1, Column - 1).Interior.ColorIndex = 4
OneRandom = True
End If
Wend

End Sub

I have now tried this game solver and it is great, thanks!

Comment made by: Ed , 2009-04-13 09:48:10

Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku Sudoku...................................... It is my favourite game!!!!!!!!!!!

Comment made by: Aida Olrwed , 2010-10-16 09:41:36

very good for saving many sudoku solvers lifes for not being a waste

Comment made by: vsr , 2011-09-11 13:28:51

where is the "tom" in the code defined?

Comment made by: netghost , 2012-06-05 19:22:22

Fantastic Effort

Comment made by: Anonymous101 , 2013-12-03 12:13:44

Wht is tom

Comment made by: Anonymoua , 2016-08-07 10:02:26

Great ! Beautiful and fast...

Comment made by: Gauthier , 2017-03-12 21:48:07

btw: tom is Swedish for "empty", the variable is not initialised so is zero - sort of a Swedish word play ;-)

Comment made by: Smud , 2017-08-05 11:44:30

I am working to write a master scheduler for the school I work at, and this is my starting point. Many thanks for a wonderful program!

Comment made by: Kate , 2017-08-07 20:15:22

# Write Comment:

 Comment: two + 3 minus 1= Your name: