How to make a sudoku in Excel

[owais87]

Hello can someone please tell me how can I make sudoku in Excel through VBA I mean I'm facing some problems in the codes I have I'll write down the codes below please do tell me what's wrong with them or if anyone can give me new ones that'll much better. And I mean that should have auto generated button etc
These are the codes i tried :
Dim SolutionGrid(1 To 9, 1 To 9) As Integer

Sub GeneratePuzzle()
Dim i As Integer, j As Integer

' Clear existing puzzle
For i = 1 To 9
For j = 1 To 9
Cells(i, j).Value = ""
Next j
Next i

' Generate new puzzle (solved)
GenerateSolution
' Display the puzzle
DisplayPuzzle
End Sub

Sub NewPuzzle()
' Clear existing puzzle
For Each cell In Range("A1:I9")
cell.Value = ""
Next cell
' Generate and display new puzzle
GenerateSolution
DisplayPuzzle
End Sub

Sub GenerateSolution()
' Generate a solved Sudoku puzzle
' For simplicity, let's assume we have a solved puzzle
' This is where you would implement your Sudoku solving algorithm or use a pre-solved grid
' For demonstration, let's use a predefined solution grid
Dim i As Integer, j As Integer
For i = 1 To 9
For j = 1 To 9
SolutionGrid(i, j) = (i + j) Mod 9 + 1
Next j
Next i
End Sub

Sub DisplayPuzzle()
' Copy the solution grid to the puzzle grid
Dim i As Integer, j As Integer
For i = 1 To 9
For j = 1 To 9
If Int(Rnd * 2) = 0 Then ' Randomly remove some numbers
Cells(i, j).Value = SolutionGrid(i, j)
Else
Cells(i, j).Value = ""
End If
Next j
Next i
End Sub
If anyone knows anything please do tell me
Thank-you

 

[Snakehips]

@owais87 Welcome.
I don't do Sudoku but was curious to have a little look at this.
I wonder if the below hybrid of vba and excel might be of value?

Use the Copy icon in the top left corner of the attached XL2BB mini sheet and Paste it into B5 of a blank sheet.
Then there are two bits of vba which if they prove to work for you can be attached to sheet buttons or whatever.
One code will create a new puzzle solution and grid.
The other will create another puzzle grid for the existing solution. You can enter different values in F24 to give some degree of variation in the number of visible numbers in the grid.

Testing Formula Update.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
5	Helpers
6	Root#	1	2	3	4	5	6	7	8	9
7	Rand	0.5	0.5	0.3	0.2	0.9	0.5	0.9	1	1
8	Rand#	6	5	8	9	3	7	2	1	4
9						3
10		Root Patern													SOLUTION :Numbers Randomised										Check
11		1	2	3	4	5	6	7	8	9					6	5	8	9	3	7	2	1	4		45
12		4	5	6	7	8	9	1	2	3					9	3	7	2	1	4	6	5	8		45
13		7	8	9	1	2	3	4	5	6					2	1	4	6	5	8	9	3	7		45
14		9	1	2	3	4	5	6	7	8					4	6	5	8	9	3	7	2	1		45
15		3	4	5	6	7	8	9	1	2					8	9	3	7	2	1	4	6	5		45
16		6	7	8	9	1	2	3	4	5					7	2	1	4	6	5	8	9	3		45
17		2	3	4	5	6	7	8	9	1					5	8	9	3	7	2	1	4	6		45
18		5	6	7	8	9	1	2	3	4					3	7	2	1	4	6	5	8	9		45
19		8	9	1	2	3	4	5	6	7					1	4	6	5	8	9	3	7	2		45
20
21														Check	45	45	45	45	45	45	45	45	45
22
23
24		Blank Factor			5
25
26
27		Puzzle Grid
28
29		9		7			4
30			1			5		9	3
31							3
32			9						6
33								8	9	3
34		5			3	7
35				2
36				6					7
37
Sheet1

Cell Formulas
Range	Formula
C8:K8	C8	=INDEX($C6:$K6,RANK(C7,$C7:$K7))
P11:X19	P11	=INDEX(C$8:K$8,C11:K19)
Z11:Z19	Z11	=SUM(P11:X11)
P21:X21	P21	=SUM(P11:P19)
Dynamic array formulas.

Hope that helps?

 

[Snakehips]

Depending upon your excel version you may need to have formula for solution range as below.
P11 abd drag down and across.

Testing Formula Update.xlsm
	O	P	Q	R	S	T	U	V	W	X	Y	Z
9
10		SOLUTION :Numbers Randomised										Check
11		6	5	8	9	3	7	2	1	4		45
12		9	3	7	2	1	4	6	5	8		45
13		2	1	4	6	5	8	9	3	7		45
14		4	6	5	8	9	3	7	2	1		45
15		8	9	3	7	2	1	4	6	5		45
16		7	2	1	4	6	5	8	9	3		45
17		5	8	9	3	7	2	1	4	6		45
18		3	7	2	1	4	6	5	8	9		45
19		1	4	6	5	8	9	3	7	2		45
20
21	Check	45	45	45	45	45	45	45	45	45
Sheet1

Cell Formulas
Range	Formula
P11:X19	P11	=INDEX($C$8:$K$8,C11)
Z11:Z19	Z11	=SUM(P11:X11)
P21:X21	P21	=SUM(P11:P19)

 

[Snakehips]

Forgot to post the vba

Sub NewPuzzle()
Dim i As Integer, j As Integer
Dim SolRng As Range, GridRng As Range
'randomise
Range("C7:K7").Formula = "=RAND()"
'Fix
Range("C7:K7").Value = Range("C7:K7").Value

Set SolRng = Range("P11:X19")
Set GridRng = Range("C28:K36")

With GridRng
    .ClearContents
    For i = 1 To 9
        For j = 1 To 9
         ' Randomise visible numbers based on Number (2-7) entered in F24
        If Int(Rnd * Range("F24")) = 0 Then .Cells(i, j) = SolRng.Cells(i, j)
        Next j
    Next i
End With

End Sub

Sub NewGridOnly()
Dim i As Integer, j As Integer
Dim SolRng As Range, GridRng As Range
Set SolRng = Range("P11:X19")
Set GridRng = Range("C28:K36")
 
With GridRng
    .ClearContents
    For i = 1 To 9
        For j = 1 To 9
         ' Randomise visible numbers based on Number (2-7) entered in F24
        If Int(Rnd * Range("F24")) = 0 Then .Cells(i, j) = SolRng.Cells(i, j)
        Next j
    Next i
End With

End Sub

Time for a lie down...