• Download SudokuSolver_demo.zip - 337.73 KB (demo application)
• Download SudokuSolver_src.zip - 409.63 KB (source code)
• Download game_files.zip - 60.57 KB (sample puzzles)

Introduction

I started trying to develop a sudoku solver in Excel using VBA. After a few interations in Excel, I moved to Visual Basic using VS2005. After doing a version of the program to deal with 9x9 (classic) sudokus, I also adapted the code to solve samurai sudoku (5 overlapping 9x9 grids). I wanted to provide both a source and demo - as there aren't too many fully featured solvers I could find in visual basic to learn from.

The logic based solvers and the UI probably took the most work - the actual brute force solver was actually pretty quick to code.

Terminology

This article doesn't go in depth into the rules of sudoku or the detail of how to solve sudoku puzzles. Just use a search engine if you want background on this. However, the basic principle is that the numbers 1-9 are placed into the rows, columns and subgrids so that every row, column and subgrid only contain each digit once. Some terms however are used below to explain the code.

Cell - individual cell where digits 1-9 can be placed

Clues/givens - in the first image above, the second and third cell hold gives/clues of 7 and 6 respectively.

Candidates/pencilmarks - in the image above, the first cell contains three candidates (2,3 and 9). It is important when trying to solve a puzzle to keep track of the various candidates.

Row - a group of 9 cellls going horizontally down the screen

Column - a group of 9 cells going vertically down the screen

Subgrid - a group of 9 cells arranged in a 3x3 grouping

Peers - in a 9x9 classic grid, each cell can 'see' up to 20 other cells (the other cells in the row, column and subgrid). Due to the rule that no digit can be repeated in a row, cell or subgrid, if you place a digit as the solution to a cell, that digit can be removed as a candidate from each of its peers. Peers for a samurai sudoku are a bit different, as some cells will have a greater number of peers, due to the five overlapping grids.

Points of Interest

The solver will try to solve puzzles using logical steps, but will also resort to a brute force algorithm for tougher puzzles. Consequently it can solve most classic 9x9 sudoku puzzles pretty much instantly or most samurai puzzles within a couple of seconds (depending on the computer). Admittedly, there are C++ solvers that can solve hundreds or thousands of puzzles per second. However, I wanted something that would solve puzzles reasonably quickly, but also be able to step through puzzles and show why particular solving steps were taken.

There is a custom control which uses GDI+ to paint clues and candidates (pencilmarks). Using a bunch of individual labels or the like was far too slow to refresh. The UI can still be a little bit slow to refresh with samurai puzzles, but is generally not too bad.

Unlike a lot of other solvers I've seen, which tend to use a two dimensional array of 81(9) to hold possible candidates for each cell, this solver uses a single array of length 81 to hold all possible candidates. Each candidate is assigned a value using the formula 2 ^ (candidate-1) to come up with a unique bitvalue for each candidate (although I've chosen to hard code this to minimise the need for this calculation). Therefore candidate 1=bit value 1, candidate 2=bit value 2, candidate 3=bit value 4, candidate 4=bit value 8 and candidate 5=bit value 16 and so forth.

So if cell 2 had candidates 1, 3 and 4 as possible values, you would set the value of the array to

_vsCandidateAvailableBits(2) = 13 (bit values 1+4+8)

rather than having to do something like

_vsCandidateAvailableBits(2,1) = True
_vsCandidateAvailableBits(2,3) = True
_vsCandidateAvailableBits(2,4) = True

The advantage of this approach is that a lot of logic based approaches to solving sudoku work on subsets, so if you wanted to check if cell 81 only has candidates 1 and 9 available it is trivial to do a simple check to see if _vsCandidateAvailableBits(81) = 257 (bit value 1 + bit value 256)

The actual solver itself is coded as a class and uses a depth first search. It will keep searching for multiple solutions, or can be set to exit after a set number of solutions are found.

Dim solver As New clsSudokuSolver
solver.intQuit = intSolverQuit ' will exit if more than the entered number of solutions are found. 
solver.blnClassic = True ' or can set to false if solving a samurai puzzle
solver.strGrid = strGame ' input puzzle string 
solver.vsSolvers = My.Settings._DefaultSolvers ' solving methods

To run the solver you need to call solver._vsUnique() which tests for a unique solution.

You can then do things like: dim blnUnique as boolean = solver._vsUnique() to check see if a puzzle has a single valid solution or not.

Brute force solver

The brute force solver is held in its own class. It is basically an iterative loop that searches for a solution, by trying to find the best guess, and unwinding guesses if they are incorrect.

The first task at hand is to load in the starting game (either a string holding 81 characters (for a 9x9 sudoku) or five strings of 81 characters separated by line breaks (for a samurai sudoku). Valid input are the characters 1-9 for starting clues and either a full stop or zero characters to represent unfilled/empty cells.

    Private Function _load(ByVal strGrid As String, Optional ByVal StrCandidates As String = "") As Boolean
        '---load puzzle---'
        _vsSteps = 1
        vsTried = 0
        ReDim _vsUnsolvedCells(0)
        Dim i As Integer
        Dim intCellOffset As Integer
        Dim strClues As String = ""
        Dim g As Integer
        Dim j As Integer
        Dim intBit As Integer
        Dim blnCandidates As Boolean = False
        Dim arrCandidates() As String = Split(StrCandidates, arrDivider)
        If arrCandidates.Length >= 81 Then blnCandidates = True
        _u = -1
        _vsCandidateCount(0) = -1
        For i = 1 To _vsCandidateCount.Length - 1
            _vsCandidateAvailableBits(i) = 511
            _vsStoreCandidateBits(i) = 0
            _vsCandidateCount(i) = -1
            If blnClassic = False Then
                If Not blnIgnoreSamurai(i) Then _vsCandidateCount(i) = 9
            Else
                _vsCandidateCount(i) = 9
            End If
            _vsLastGuess(i) = 0
            _vsCandidatePtr(i) = 1
            _vsSolution(i - 1) = 0
            _vsPeers(i) = 0
        Next

        strGrid = Trim(strGrid)
        Dim midStr As String = ""
        Dim ptr As Integer
        Dim arrayPeers(0) As String
        Dim intValue As Integer
        Dim nextGuess As Integer = 0
        Dim nextCandidate As Integer = 0
        _vsUnsolvedCells(0) = New List(Of Integer)
        Dim intMaxGrid As Integer = 5
        If blnClassic Then intMaxGrid = 1
        For g = 1 To intMaxGrid
            For i = 1 To 81
                Select Case blnClassic
                    Case True
                        midStr = Mid(strGrid, i, 1)
                        intCellOffset = i
                    Case False
                        midStr = Mid(strGrid, i + (81 * (g - 1)), 1)
                        intCellOffset = intSamuraiOffset(i, g)
                End Select
                Select Case Asc(midStr)
                    Case 46, 48
                        '---blank---
                        If (blnClassic Or Not blnIgnoreSamurai(intCellOffset)) AndAlso _vsUnsolvedCells(0).IndexOf(intCellOffset) = -1 Then
                            _u += 1
                            _vsUnsolvedCells(0).Add(intCellOffset)
                            If blnCandidates = True Then
                                '---insert known candidates---
                                _vsCandidateAvailableBits(intCellOffset) = arrCandidates(intCellOffset - 1)
                                _vsCandidateCount(intCellOffset) = intCountBits(arrCandidates(intCellOffset - 1))
                            End If
                        End If
                    Case 49 To 57
                        '---numeric 1 to 9---
                        intValue = CInt(midStr)
                        intBit = intGetBit(intValue)
                        If _vsSolution(intCellOffset - 1) = 0 Then
                            _vsSolution(intCellOffset - 1) = intValue
                            _vsCandidateCount(intCellOffset) = -1
                            If blnCandidates = False Then
                                Select Case blnClassic
                                    Case True
                                        arrayPeers = arrPeers(intCellOffset)
                                    Case False
                                        arrayPeers = ArrSamuraiPeers(intCellOffset)
                                End Select
                                '---remove value from peers---
                                For j = 0 To UBound(arrayPeers)
                                    ptr = arrayPeers(j)
                                    If _vsCandidateAvailableBits(ptr) And intBit Then
                                        _vsCandidateAvailableBits(ptr) -= intBit
                                        _vsCandidateCount(ptr) -= 1
                                    End If
                                Next
                            End If
                        End If
                    Case Else
                        'Debug.Print("exiting due to invalid character " & Asc(midStr))
                        _load = False
                        Exit Function
                End Select
                strClues += midStr
            Next
            If Not blnClassic Then strClues += vbCrLf
        Next
        _load = True
        strFormatClues = strClues
    End Function

Oonce we have some valid input, we call a function that will loop to test for all solutions (although it is possible to set a value (intQuit) to exit when a desired number of solutions have been found). For example, if you want to ensure a puzzle is valid (e.g. only has a single unique solution) then intQuit can be set to '2' (so it will exit after finding two solutions). However, there can be instances (such as explained further below) where finding multiple solutions can be useful for solving samurai puzzles.

The main solving function is set out below.

Private Function _vsbackTrack(ByVal strGrid As String, ByRef StrSolution As String, Optional ByVal StrCandidates As String = "") As Boolean 
Dim intMax As Integer = 0
Dim intSolutionMax As Integer = 0
ReDim Solutions(0) ' array to hold solutions to the puzzle 
Dim i As Integer 
Dim j As Integer 
Dim intSolutions As Integer ' counts number of puzzle solutions 
Dim testPeers(0) As String 
Dim tempPeers As String 
Dim nextGuess As Integer = 0
Dim nextCandidate As Integer = 0
        Select Case blnClassic ' sets up maximum length of arrays depending on whether it is a 9x9 or samurai puzzle
            Case True
                intMax = 81
                intSolutionMax = 80
            Case False
                intMax = 441
                intSolutionMax = 440
        End Select
        ReDim _vsSolution(intSolutionMax)
        ReDim _vsPeers(intMax)
        ReDim _vsCandidateCount(intMax)
        ReDim _vsCandidateAvailableBits(intMax)
        ReDim _vsCandidatePtr(intMax)
        ReDim _vsLastGuess(intMax)
        ReDim _vsStoreCandidateBits(intMax)
        ReDim _vsRemovePeers(intMax)

        If Not _load(strGrid:=strGrid, StrCandidates:=StrCandidates) Then
            ' input puzzle failed to load properly, so exit
            intCountSolutions = intSolutions
            Exit Function
        End If

        '---NOTE: Code for logic based solving methods is usually called here---'
        '---But removed for purposes of explaining the brute force solver---'
        '---END NOTE---'

        _vsUnsolvedCells(0).Sort() '---order an array list of empty/unsolved cells---'

        '---NOTE: Some specific code removed here for dealing with samurai puzzles---'
        '---This is discussed separately below---'
        '---END NOTE---'

        '---setup peer array. This is intended to save processing time by---'
        '---having the 'peers' for each empty cell pre-loaded, rather than needing---'
        '---to recalculate peers throughout the iterative puzzle solving process---'
        For i = 0 To _u
            tempPeers = ""
            Select Case blnClassic
                '---this code retrieves a hard coded list of 'peers' (other cells---'
                '---that share a row, column or subgrid with the empty cell---'
                Case True
                    testPeers = arrPeers(_vsUnsolvedCells(0).Item(i))
                Case False
                    testPeers = ArrSamuraiPeers(_vsUnsolvedCells(0).Item(i))
            End Select
            For j = 0 To UBound(testPeers)
                '---Check to see if each peer is unsolved or not. 
                '---If the peer is empty/unsolved, then add it to a string---'
                If _vsUnsolvedCells(0).IndexOf(CInt(testPeers(j))) > -1 Then
                    If tempPeers = "" Then
                        tempPeers = testPeers(j)
                    Else
                        tempPeers += "," & testPeers(j)
                    End If
                End If
            Next
            _vsPeers(_vsUnsolvedCells(0).Item(i)) = tempPeers 
            '---save the list of peers for each empty cell---'
        Next
        '---end setup peer array---'

        If _u = -1 Then
            '---puzzle already solved by logic---'
            Exit Function
        End If

        While _vsSteps <= _u + 1 AndAlso _vsSteps > 0
            '---look for the next unfilled cell. The routine intFindCell looks---' 
            '---for the next empty cell containing only one candidate---'
            '---or failing that, the unfilled cell with the lowest number of---'
            '---candidates which will result in the maximum number of possible---'
            '---eliminations. There may be room for improvement/experimentation in 
            '---terms of picking the next cell to test---'
            If nextGuess = 0 Then nextGuess = intFindCell()
            If nextGuess > 0 Then
                '---we have an empty cell, so select the next candidate---' 
                '---to test in this cell---'
                nextCandidate = IntNextCandidate(nextGuess)
                If nextCandidate > 0 Then
                    vsTried += 1
                    MakeGuess(nextGuess, nextCandidate)
                    nextGuess = 0
                Else
                    If _vsSteps <= 1 Then
                        '---we've reached the end of the search
                        '---there are no more steps to try---'
                        Select Case intSolutions
                            Case 0
                                '---invalid puzzle (no solution)---'
                                _vsbackTrack = False
                                intCountSolutions = 0
                                Exit Function
                            Case 1
                                '---single solution---'
                                _vsbackTrack = True
                                intCountSolutions = 1
                                Exit Function
                            Case Else
                                '---multiple solutions---'
                                _vsbackTrack = False
                                intCountSolutions = intSolutions
                                Exit Function
                        End Select
                    Else
                        '---need to go back...no remaining candidates for this cell---'
                        UndoGuess(nextGuess)
                    End If
                End If
            Else
                If _vsSteps = 0 Then
                    _vsbackTrack = False
                    '---invalid puzzle---'
                    intCountSolutions = intSolutions
                    Exit Function
                Else
                    '---cannot go further...so need to go back---'
                    UndoGuess()
                End If
            End If

            If _vsSteps > _u + 1 Then
                '---we have filled all the unfilled cells with a solution---'
                '---so increase array size and add next solution to solution array---'
                intSolutions += 1
                ReDim Preserve Solutions(intSolutions - 1)
                Select Case blnClassic
                    Case True
                        StrSolution = strWriteSolution(intGrid:=1)
                    Case False
                        StrSolution = strWriteSolution()
                End Select
                Solutions(intSolutions - 1) = StrSolution

                If intSolutions = intQuit Then
                    '---quit if number of solutions exceeds a given number---'
                    _vsbackTrack = False
                    intCountSolutions = intSolutions
                    Exit Function
                End If

                '---solution found so backtrack---'
                UndoGuess()
            End If
        End While
    End Function

A key part of the brute force solver is doing a 'look ahead' to try to pick the next best unfilled cell to try placing an available candidate. The function below aims to do this by looking for an empty cell with the minimum number of candidates available. If there is a cell with only a single candidate, this is selected, as this is an optimal guess. Otherwise, the intention is to look for an unfilled cell with the smallest number of candidates (as this reduces the overall search space/solving time). As an additional refinement, if there are multiple unfilled cells each with the same number of candidates, an additional loop is used to determine which of these cells has the highest number of peers (on the basis that any guess made will have the highest chance of removing further candidates from the puzzle). There may be other approaches that can be trialled, as finding the best possible next move is most likely to increase the solving speed.

Private Function intFindCell() As Integer
        Dim i As Integer
        Dim j As Integer
        Dim ptr As Integer
        Dim ptr2 As Integer
        Dim arrPeers() As String
        Dim intCell As Integer
        Dim intCount As Integer
        Dim intPeerCount As Integer

        For i = 0 To 9
            '---iterate array that holds number of candidates for each cell---' 
            '---starting from lowest possible candidates to highest---' 
            ptr = Array.IndexOf(_vsCandidateCount, i)
            If ptr > -1 Then
                intFindCell = ptr
                If i = 0 Then
                    intFindCell = 0
                End If
                If i = 1 Then Exit Function

                While ptr2 > -1
                    ptr2 = Array.IndexOf(_vsCandidateCount, i, ptr2)
                    If ptr2 > -1 Then
                        arrPeers = Split(_vsPeers(ptr2), arrDivider)
                        intPeerCount = 0
                        For j = 0 To UBound(arrPeers)
                            If arrPeers(j) <> "" AndAlso _vsUnsolvedCells(0).IndexOf(arrPeers(j)) > -1 Then
                                intPeerCount += 1
                            End If
                        Next
                        If intPeerCount >= intCount Then
                        '---look for unfilled cell with largest number of peers---'
                            intCount = intPeerCount
                            intCell = ptr2
                        End If
                        ptr2 += 1
                    End If
                End While
                intFindCell = intCell
                Exit For
            End If
        Next
    End Function

Once an unfilled cell has been selected, the next step is to find the next available candidate in that cell, as detailed below.

    Private Function IntNextCandidate(ByVal intCell As Integer, Optional ByVal blnLookup As Boolean = False) As Integer
        Dim c As Integer
        Dim intBit As Integer
        For c = _vsCandidatePtr(intCell) To 9
            intBit = intGetBit(c)
            If _vsCandidateAvailableBits(intCell) And intBit Then
                IntNextCandidate = c
                If blnLookup = False Then _vsCandidatePtr(intCell) = c + 1
                '---increment the value for _vsCandidatePtr---' 
                '---by incrementing _vsCandidatePtr it is faster to loop---' 
                '---through and find the next available candidate to be tested---' 
                Exit Function
            End If
        Next
    End Function

The other main items required are functions to make guesses, and wind back guesses respectively. A key issue is keep track of where candidates have been removed from the peers of a cell as the result of a guess. Without accurately recording this, it is not possible to properly undo guesses as required.

    Private Function MakeGuess(ByVal intCell As Integer, ByVal intCandidate As Integer) As Boolean
        Dim arrayPeers() As String
        Dim j As Integer
        Dim ptr As Integer
        Dim intBit As Integer
        _vsSolution(intCell - 1) = intCandidate
        _vsCandidateCount(intCell) = -1
        _vsLastGuess(_vsSteps) = intCell
        '----remove from unsolved cells list---
        _vsUnsolvedCells(0).Remove(intCell)
        setCandidates(intCell, intCandidate)
        _vsSteps += 1
        arrayPeers = Split(_vsPeers(intCell), ",")
        '---remove value from peers---
        _vsRemovePeers(intCell) = New List(Of Integer)
        intBit = intGetBit(intCandidate)
        For j = 0 To UBound(arrayPeers)
            ptr = arrayPeers(j)
            If _vsSolution(ptr - 1) = 0 AndAlso (_vsCandidateAvailableBits(ptr) And intBit) Then
                _vsCandidateAvailableBits(ptr) -= intBit
                _vsCandidateCount(ptr) -= 1
                _vsRemovePeers(intCell).Add(ptr)
                If _vsCandidateCount(ptr) = 0 Then Exit Function
            End If
        Next
    End Function
    Private Function UndoGuess(Optional ByRef nextGuess As Integer = 0) As Boolean
        Dim intCell As Integer = 0
        Dim intCandidate As Integer = 0
        Dim blnLoop As Boolean = True
        _vsCandidatePtr(nextGuess) = 1
        _vsSteps -= 1
        If _vsSteps = 0 Then Exit Function
        intCell = _vsLastGuess(_vsSteps)
        intCandidate = _vsSolution(intCell - 1)
        '---restore to unsolved list---
        _vsUnsolvedCells(0).Add(intCell)
        '---sort unsolved cells---
        _vsUnsolvedCells(0).Sort()
        Dim j As Integer
        Dim i As Integer = 1
        Dim c As Integer
        Dim tC As Integer
        Dim intBit As Integer = intGetBit(intCandidate)
        Dim lbit As Integer = 0
        '---restore candidates in this cell---
        If intCell > 0 Then
            If Not (_vsStoreCandidateBits(intCell) And intBit) Then
                _vsStoreCandidateBits(intCell) += intBit
            End If
        End If
        lbit = _vsStoreCandidateBits(intCell)
        _vsCandidateAvailableBits(intCell) = 0
        For c = 1 To 9
            intBit = intGetBit(c)
            If lbit And intBit Then
                _vsCandidateAvailableBits(intCell) += intBit
                tC += 1
            End If
        Next

        nextGuess = intCell
        _vsSolution(intCell - 1) = 0
        _vsCandidateCount(intCell) = tC

        If intCell = 0 Then
            '---no valid solution found---
            Exit Function
        End If

        '---restore value to peers---
        Dim pCell As Integer
        For j = 0 To _vsRemovePeers(intCell).Count - 1
            pCell = _vsRemovePeers(intCell).Item(j)
            _vsCandidateAvailableBits(pCell) += intGetBit(intCandidate)
            _vsCandidateCount(pCell) += 1
        Next
        '---end restore values to peers---
    End Function

Brute force - Samurai puzzles

All sudoku puzzles are considered NP-complete. In short, as the size of the grid increases, so does the potential time/computational effort to find a solution.

For samurai puzzles, where there are five overlapping grids, it is unfortunately not just a matter of individually solving each of the five 9x9 grids in turn, as it is usually the case that few or none of the individual grids taken in isolation have a unique solution - you usually need to solve all five overlapping grids as a single puzzle.

However, the code below is used to help reduce the solving time for harder samurai puzzles. It basically involves testing to see if more than 1 but less than 100 solutions to an individual 9x9 grid can be found. Obviously, this won't always work, as there are often more than 100 solutions for an individual grid. However, if there are less than 100 solutions, the collection of solutions is checked. If an empty cell has exactly the same digit appearing in each and every solution found, we can then place that digit as this must be the correct answer for that cell.

If _u > -1 Then
            If Not blnClassic Then
                Dim g As Integer
                For g = 1 To 5
                    Dim Solver As New clsSudokuSolver
                    Solver.blnClassic = True
                    Solver.strGrid = strWriteSolution(intGrid:=g)
                    Solver.vsSolvers = My.Settings._UniqueSolvers
                    Solver.intQuit = 100
                    Solver._vsUnique()
                    If Solver.intCountSolutions > 1 AndAlso Solver.intCountSolutions < Solver.intQuit Then
                        Dim s As Integer
                        Dim c As Integer
                        Dim m(81) As Integer
                        Dim chk(81) As Boolean
                        Dim chr As String
                        Dim intChr As Integer
                        For c = 1 To 81
                            chk(c) = True
                        Next
                        For s = 0 To UBound(Solver.Solutions)
                            If Array.IndexOf(chk, True) = -1 Then Exit For
                            For c = 1 To 81
                                chr = Mid(Solver.Solutions(s), c, 1)
                                intChr = CInt(chr)
                                If m(c) = 0 Then
                                    m(c) = intChr
                                Else
                                    If intChr <> m(c) Then
                                        chk(c) = False
                                        m(c) = -1
                                    End If
                                End If
                            Next
                        Next
                        Dim strRevised As String = ""
                        Dim blnRevised As Boolean
                        Dim ptr As Integer
                        Dim arrayPeers() As String
                        Dim intBit As Integer
                        For c = 1 To 81
                            chr = Mid(Solver.strGrid, c, 1)
                            If chr = "." Then
                                '---unique value across all solutions---
                                '---and not found in starting grid---
                                If m(c) > 0 Then
                                    strRevised += CStr(m(c))
                                    blnRevised = True
                                    '---place solution---
                                    ptr = intSamuraiOffset(c, g)
                                    If _vsSolution(ptr - 1) = 0 Then
                                        _vsSolution(ptr - 1) = m(c)
                                        _vsCandidateCount(ptr) = -1
                                        _vsUnsolvedCells(0).Remove(ptr)
                                        arrayPeers = ArrSamuraiPeers(ptr)
                                        intBit = intGetBit(m(c))
                                        'remove value from peers
                                        For j = 0 To UBound(arrayPeers)
                                            If _vsSolution(arrayPeers(j) - 1) = 0 AndAlso (_vsCandidateAvailableBits(arrayPeers(j)) And intBit) Then
                                                _vsCandidateAvailableBits(arrayPeers(j)) -= intBit
                                                _vsCandidateCount(arrayPeers(j)) -= 1
                                            End If
                                        Next
                                        _u -= 1
                                    End If
                                    '--end place solution---
                                Else
                                    strRevised += chr
                                End If
                            Else
                                strRevised += chr
                            End If
                        Next
                        If blnRevised Then
                            blnRevised = False
                        End If
                    End If
                Next
            End If
        End If

Generating puzzles

Another thing I wanted to ensure was that I could generate sudoku puzzles of different difficulties. I initially just tried starting with filled grids and randomly removing digits...but this simply resulted in to lots of easy puzzles, but very few difficult ones. The code below seems to help give a better range of generated puzzles. The code below can be used to still result in a certain randomness in the deletion of clues from cells, but with the constraint that a certain number of a particular digit will remain (e.g. it might delete 7 instances of the digit '8' and 6 instances of the digit '3' and the next time it might delete 7 instances of the digit '2' and 6 instances of the digit '4' and so forth)

Function RemoveCellsNoSymmetry(ByVal strGrid As String) As String
        Dim fp As Integer
        Dim i As Integer
        Dim j As Integer
        Dim k As Integer
        Dim p As Integer
        Dim r As Integer
        Dim r2 As Integer
        Dim intRemoved As Integer
        Dim strGeneratorSeed As String = "0122211000"
        Dim randomArr() As String = Split(GenerateRandomStr(arrDivider), arrDivider)
        Dim randomArr2() As String
        Dim ptr As Integer
        Dim arrGame(0) As Integer
        Dim arrPos(0) As Integer
        Dim midStr As String = ""
        strGrid = Replace(strGrid, vbCrLf, "")
        ReDim arrGame(81)

        '---load game into array---
        For p = 1 To 81
            midStr = Mid(strGrid, p, 1)
            ptr = p
            If midStr <> "" AndAlso CInt(midStr) > 0 Then
                arrGame(ptr) = CInt(midStr)
            End If
        Next
        '---finish load game into array---

        For i = 0 To 9
            r = Mid(strGeneratorSeed, i + 1, 1)
            For j = 1 To CInt(r)
                Debug.Print(randomArr(k) & " will be found " & i & " times so delete " & 9 - i & " instances")
                '---start delete---'
                fp = -1
                For p = 1 To 81
                    If arrGame(p) = randomArr(k) Then
                        fp += 1
                        ReDim Preserve arrPos(fp)
                        '---save all positions where digit found---'
                        arrPos(fp) = p
                    End If
                Next

                '---randomly remove from array of cell positions---' 
                intRemoved = 0
                randomArr2 = Split(GenerateRandomStr(arrDivider), arrDivider)
                For r2 = 0 To UBound(randomArr2)
                    If intRemoved >= (9 - i) Then Exit For
                    arrGame(arrPos(randomArr2(r2) - 1)) = 0
                    intRemoved += 1
                Next
                '---end delete---
                k += 1
            Next
        Next

        RemoveCellsNoSymmetry = ""
        For p = 1 To 81
            ptr = p
            If arrGame(ptr) <> "0" Then
                RemoveCellsNoSymmetry += CStr(arrGame(ptr))
            Else
                RemoveCellsNoSymmetry += "."
            End If
        Next

    End Function

Next Steps/Improvements

I wrote this mainly as a personal challenge. The key thing I'd like to do is improve the speed of the brute force solver, especially so it can solve samurai puzzles much more quickly, and improve the redraw speed so the GDI custom controls refresh faster. I might also do a version that will deal with other variants (such as jigsaw sudoku puzzles).

Sample Application

The sample application is fully featured and lets you enter, solve, optmise and generate classic (9x9) sudoku puzzles and will let you enter and solve samurai puzzles.