Pages

Saturday, January 6, 2018

Excel Sudoku Generator

In this post we see how to create Sudoku puzzles with Excel VBA macros. Excel Sudoku Generator creates completely random puzzles with three levels of difficulty. The VBA code uses decremental generation with algorithms to ensure removed numbers do not compromise a unique solution, with the peculiarity of not using any solver to do so. This version of Excel Sudoku Generator was shared for learning purposes and is not the most efficient though. A simpler version has been created to help readers better understand the VBA code: Excel Simple Sudoku Generator. An improved version to create professional Sudoku puzzles is also available for download here: Excel Sudoku Pro. You can also play Sudoku Pro online now!


Formatting a Sudoku Layout

The first macro creates the characteristic 9x9 Sudoku layout applying some basic VBA formatting properties to the range B2:J10. It is a good example to learn how to use common Cells and Range-related properties such as Text, Color, Borders, and other. In the second half of the macro, we see how to apply validation to a cell using VBA.




 
  Sub FormatLayout()
   
    'Clear content and format a 9x9 Sudoku layout
    Cells.Clear
    Cells.Interior.Color = vbWhite
   
    With Range("B2:J10")
        .ColumnWidth = 5
        .RowHeight = 28
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Size = 24
        .Font.Color = vbBlack
        .Font.Bold = True
        .Borders.LineStyle = xlContinuous
        .BorderAround LineStyle:=xlContinuous, Weight:=xlThick
    End With
   
    Range("E2:G4").BorderAround LineStyle:=xlContinuous, Weight:=xlThick
    Range("B5:D7").BorderAround LineStyle:=xlContinuous, Weight:=xlThick
    Range("H5:J7").BorderAround LineStyle:=xlContinuous, Weight:=xlThick
    Range("E8:G10").BorderAround LineStyle:=xlContinuous, Weight:=xlThick
   
    'Format a cell to select puzzle level
    With Range("L2")
        .Value = "Level"
        .Font.Bold = True
        .Interior.ColorIndex = 15
    End With
   
    With Range("L2:L3")
        .HorizontalAlignment = xlCenter
        .Font.Size = 14
    End With
   
    Dim LevelList As String
    LevelList = "Easy, Intermediate, Difficult"
    With Cells(3, 12).Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=LevelList
        .InCellDropdown = True
        .ShowInput = True
    End With
   
    Range("L3") = "Easy" 'Level "Easy" will appear as default
   
  End Sub
 

 


 

Completely Filled Sudoku Grid

Excel Sudoku Generator creates puzzles using decremental generation, i.e. it first adds all the numbers to fill the entire Sudoku grid, and then removes some numbers to leave the gaps of the final puzzle. Did you ever attempt to fill an empty Sudoku grid from scratch? Give it a try!

 

There are several ways to do that. The easiest way is to create a trivial puzzle based on a simple mathematical formula. The simplest formula leads to a linear sequence as the one shown in the picture below.


That’s however not the best approach, and filling the grid randomly is preferred instead. There are several ways to do that (learn more about different techniques to fill the entire Sudoku grid in this other post).

The method used to add numbers in Excel Sudoku Generator is a modification of the brute force approach. You can find that simpler approach in this other post, which is probably a better example to understand how to use loops and conditional statements to fill the Sudoku grid with Excel VBA. It is less efficient and takes longer time though. The macro example below is also not perfect, but applies a backtracking algorithm to improve and speed up the process. There are yet other better ways to do it. For example, Excel Sudoku Pro uses a smarter backtracking algorithm, and writes/reads the values to/from an array instead of doing it directly in the worksheet. That speeds up the whole process and allows to fill the entire grid in less than a second.

 
  Dim Sudoku As Worksheet, SudokuGrid As Range
 
  Sub CreatePuzzle()
   
    Dim r As Integer, c As Integer, rr As Integer, rc As Integer
    Dim num As Integer, n As Integer, ir As Integer, ic As Integer
    Dim ref1 As Variant, ref2 As Variant, rep(10) As Integer
   
    Set Sudoku = ThisWorkbook.Sheets("SUDOKU")
    Set SudokuGrid = Sudoku.Range("B2:J10")
   
    'Clear previous sudoku numbers
    With SudokuGrid
        .ClearContents
        .Font.Bold = True
        .Font.Color = vbWhite 'This will hide numbers while filling the new puzzle
    End With
   
    'Loop to put numbers into the puzzle randomly (by number and by quadrant)
    num = 1
    Sudoku.Select
    Do
        For rr = 1 To 7 Step 3
            For rc = 1 To 7 Step 3
                Do
                Randomize
                r = Int(((rr + 2) - rr + 1) * Rnd + rr)
                c = Int(((rc + 2) - rc + 1) * Rnd + rc)
                If Cells(r + 1, c + 1) = "" Then
                    Set ref1 = Columns(c + 1).Find(What:=num)
                    If ref1 Is Nothing Then
                        Set ref2 = Rows(r + 1).Find(What:=num)
                        If ref2 Is Nothing Then
                            Cells(r + 1, c + 1).Value = num
                            Exit Do
                        End If
                    End If
                End If
                n = n + 1
                Loop Until n > 99
    back:
                If n > 99 Then
                    For ir = 2 To 10
                        For ic = 2 To 10
                            If Cells(ir, ic).Value = num Then
                                Cells(ir, ic).Value = ""
                            End If
                        Next ic
                    Next ir
                    n = 0
                    rep(num) = rep(num) + 1
                    GoTo cont
                End If
                n = 0
            Next rc
        Next rr
        num = num + 1
        rep(num) = 0
    cont:
        If rep(num) > 5 Then
            num = num - 1
            rep(num) = 0
            GoTo back
        End If
    Loop Until num = 10
   
    Call CopySolution
    Call FinishPuzzle
   
  End Sub
 

The macro adds numbers from 1 to 9 in a Do loop, to random positions within each block, and making sure each number complies with the Sudoku rules using the Find method to check the occurrences of each number in the row, column, and block. There is however a better approach to do that using the Excel CountIf worksheet function along with a function to return the address of each block. You can find more details and the code in this other post: Excel Simple Sudoku Generator

Once this first step is complete, we can save the grid as the solution of the Sudoku puzzle. The seconds step consists of removing certain numbers to leave the gaps of the final Sudoku puzzle.




Remove Numbers to Create the Puzzle

There are several techniques to remove numbers from a completely filled Sudoku grid and ensure a unique solution is not compromised. Ultimately, a solver can be used to confirm the puzzle is correct and does not have more than one solution. Excel Sudoku Generator applies some of these techniques to remove numbers for each level of difficulty. However, this version of Excel Sudoku Generator has the peculiarity of not using any solver to do so. The drawback is though, that this approach cannot generate Sudoku puzzles of great complexity or difficulty. An updated version that combines these techniques with a solver engine to generate puzzles of higher difficulty can be found here: Excel Sudoku Pro.  You can also learn more about the different techniques used to solve Sudoku puzzles with Excel VBA in this other post: Excel Sudoku Solver.

Despite the level of difficulty of Sudoku puzzles does not necessarily correlate with the number of hints given (rather with the set of techniques needed to solve it), this version of Excel Sudoku Generator sets some limits to reduce the impact of the randomness of the process, so the higher the difficulty, the more numbers are removed.

  • Level Easy:  Randomly removes numbers that cannot be placed in any other cell within the same row, column, or block (RemoveRound1). It generates puzzles with approximately 45 initial hints that can easily be solved by single position.
  • Level Intermediate: Removes numbers from an Easy generated puzzle that can only be placed in one other cell within the same row, column, or block, then blocking that row and column from having more numbers removed (RemoveRound2). Additionally, it checks for pairs (CheckDupletes) to avoid removing all numbers in pairs that would otherwise generate two slightly different solutions. This generates puzzles with a 38 to 40 initial hints, that can be solved by exclusion and single position.
  • Level Difficult: Further removes numbers from an Intermediate generated puzzle, checking for pairs and triads within the Sudoku grid, and assigning a weightage to each position to determine which numbers are safe to remove. It generates puzzles with around 32 hints that can be solved by exclusion and block intersection techniques.

 

 

There have been several improvements to this version of Excel Sudoku Generator. You can check these other posts to get more info about generating and solving Sudoku puzzles with Excel VBA.


 

20 comments:

  1. hi there, are there any tutorials you would recommend to get started on learning VBA?
    Thanks for the great games

    ReplyDelete
    Replies
    1. Hi, I recommend starting with the Excel VBA/Macros training for beginners here: https://excelmacroclass.blogspot.com/p/training-for-beginners.html

      Delete
    2. Hello again, I have put together a very practical guide to learn Excel VBA/Macros. Find it here along with other books I would recommend. There are many other learning resources in that blog. Hope that helps!
      https://excelmacroclass.blogspot.com/p/ebooks-and-guides.html

      Delete
  2. Hi there. Thanks for this, works great! I'm trying to modify to make this 4x4 so I can get my kids interested in Sudoku. However, whatever modifications I try in the script Excel keeps going into not responding. Could you or anyone please help? I managed to work out the Layout module. But think I'm doing something wrong in the Puzzle module in those loops. Cheers, Davis.

    ReplyDelete
    Replies
    1. Hi Davis, find the 4x4 version under the link below. I just tweaked a couple of things in those loops within the Puzzle module and allowed for just 2 levels of difficulty. I hope your kids enjoy and have fun!
      https://drive.google.com/open?id=1G-wqd9lP5PF9pkfxLp6fUR_kAq1TVmsf

      Delete
    2. Thank you so much for such a quick response. Really appreciate it! Happy to confirm it works great. Now the challenge of getting them interested haha! Have a good one and keep safe. Cheers, Davis.

      Delete
  3. Thanks for your code. I generated a difficult sudoku, but, when I solved it, my solution is ok but is not the same as the original. How could we avoid multiple solutions for the puzzle?

    ReplyDelete
    Replies
    1. Thanks for the feedback Roger. I have recently updated the code with some algorithms that check removed numbers do not compromise a unique solution. I tested it through and seems to work well, but to fully avoid that, additional coded is needed to resolve and disregard if there is more than one solution. I am working on that and will hopefully publish it here soon.

      Delete
  4. Thanks for your code. I search for it long time. But when I try out your vba, it will run and never stop... which I have to press break, and then the puzzle show up. I try to search which loop is unstoppable, but I can't find it.

    ReplyDelete
    Replies
    1. Hi, thanks for bringing that up. It works perfectly in my system though, but I'll have a look again at the code to see what could cause that. Does that happen with all levels of difficulty? What version of Excel do you use? Do you use Win 32 or 64 bit? What's your RAM and CPU?

      Delete
  5. Hi, I don't understand the code well enough to increase it but the difficult setting on this is very easy for me. I looked through the round removals and I understand how it gets to them. I don't understand what I would tweak to get to the very difficult setting.

    ReplyDelete
    Replies
    1. Thanks for your message. You’ll need to create a loop in Round1 to maximize gaps there, and then change the numCount threshold in Rounds 2 and 3. Additionally you could clear some cells of the number with most occurrences after Round 3. However, both techniques require a solver to ensure the final solution is unique. I am working on an updated version that will incorporate that and allow to create very difficult puzzles for pros like you :-)

      Delete
  6. Hi and thank you for sharing this nice work.
    I tried to adapt your file to make a 6x6 grid, but unfortunately, it doesn't work.

    Did you try to make a 6x6 grid?

    cheers
    Simon

    ReplyDelete
    Replies
    1. Hi Simon, I have put together a 6x6 Sudoku generator using some other code that I have for a class tutorial (not so efficient but more simple). Have a look at the code, I am sure you will understand it better and manage to twist it to get any other size. I never tried a 6x6 but I think this creates rather easy or intermediate puzzles. Let me know what you think!
      https://drive.google.com/file/d/14cjYq4Pihh6PKMrhvJ3G0bvGvkMGiaMS/view?usp=sharing

      Delete
  7. Hello, Thank you for everything done here. This is very helpful. Could I please ask for help doing the exact same task in google sheets. I'm not here for the coding lesson although I find it fascinating... I just would like to use the finished copy in Sheets instead of Excel. I tried to copy paste the macro into the Apps Script editor and import the macro into sheets, but I don't understand enough to make it work. Would someone please just help me with a working version of the sedoku generator on google sheets? Thank you, and Im sorry I have to ask.

    ReplyDelete
    Replies
    1. Hi there! Google Sheets uses JavaScript not Visual Basic, so the program needs to be re-coded. That’s something I would like to do in future as I am already moving some things to Sheets, but I am now about to finish an improved Sudoku generator and solver with more levels of difficulty and additional functionality including the possibility to share/upload puzzles to the cloud, which would probably be the reason you are interested to use Sheets.

      Delete
  8. The contact form is not working. Click on submit does nothing.

    ReplyDelete
    Replies
    1. The contact form does work correctly, I received your message. I will reply to your email soon.

      Delete
    2. Oh, sorry, my bad then. I clicked on submit expecting something to happen but nothing did. I then found another site that used Google form, not sure how that opened up but it did. Sorry for the multiple messages if the form here does work.

      Delete
    3. No worries, thanks for letting me know. I guess I received your message through the other form then. I have now replaced the contact form here with a Google Form as I have in other blogs. I really appreciate people letting me know when something does not work in my bogs.

      Delete