initial code (#2)

Class Modules/List.cls

@@ -0,0 +1,37 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "List"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'List of properties
+Private Head As node
+Private Tail As node
+Public Length As Integer
+Public Sub Add(node As node)
+  If Tail Is Nothing Then
+    Set Tail = node
+    Set Head = node
+  Else
+    Set Tail.NextNode = node
+    Set node.PrevNode = Tail
+    Set Tail = node
+  End If
+  Length = Length + 1
+End Sub
+Public Function PopNode() As node
+  If Length < 1 Then
+    Err.Raise vbObjectError + 513, "List", "Cannot pop a node on an empty list!"
+  End If
+
+  Set PopNode = Tail
+  Set Tail = PopNode.PrevNode
+  Length = Length - 1
+End Function
+
+

Class Modules/Node.cls

@@ -0,0 +1,132 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "Node"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'List of properties
+Private Values(1 To 9, 1 To 9) As Integer
+Public NextNode As node
+Public PrevNode As node
+Private filledValues As Integer
+Private Sub Class_Initialize()
+  filledValues = 0
+End Sub
+Public Function GetValue(row As Integer, col As Integer) As Integer
+  GetValue = Values(row, col)
+End Function
+Public Sub SetValue(row As Integer, col As Integer, value As Integer)
+  Values(row, col) = value
+  If value <> 0 Then
+    filledValues = filledValues + 1
+  End If
+End Sub
+Public Function Clone() As node
+  Set Clone = New node
+  Dim row As Integer
+  Dim col As Integer
+
+  For row = 1 To 9
+    For col = 1 To 9
+      Call Clone.SetValue(row, col, Values(row, col))
+    Next col
+  Next row
+End Function
+Public Function IsValidSudoku(pos As position) As Boolean
+  Dim value As Integer
+  Dim row As Integer
+  Dim col As Integer
+  Dim Map(1 To 9) As Boolean
+
+  'scan row where new value was inserted
+  Call ResetMap(Map)
+  For col = 1 To 9
+    value = Values(pos.row, col)
+    If value <> 0 Then
+      If Map(value) Then
+        'Duplicate number found
+        IsValidSudoku = False
+        Exit Function
+      Else
+        Map(value) = True
+      End If
+    End If
+  Next col
+
+  'scan col where new value was inserted
+  Call ResetMap(Map)
+  For row = 1 To 9
+    value = Values(row, pos.col)
+    If value <> 0 Then
+      If Map(value) Then
+        'Duplicate number found
+        IsValidSudoku = False
+        Exit Function
+      Else
+        Map(value) = True
+      End If
+    End If
+  Next row
+
+  'scan square where new value was inserted
+  Dim squareCornerRow As Integer
+  Dim squareCornerCol As Integer
+  squareCornerRow = pos.row - (pos.row - 1) Mod 3
+  squareCornerCol = pos.col - (pos.col - 1) Mod 3
+  Call ResetMap(Map)
+
+  For row = 0 To 2
+    For col = 0 To 2
+      value = Values(row + squareCornerRow, col + squareCornerCol)
+      If value <> 0 Then
+        If Map(value) Then
+          IsValidSudoku = False
+          Exit Function
+        Else
+          Map(value) = True
+        End If
+      End If
+    Next col
+  Next row
+
+  'no violations found, so it's a valid Sudoku
+  IsValidSudoku = True
+End Function
+Public Function IsSolvedSudoku() As Boolean
+  IsSolvedSudoku = filledValues = 9 * 9
+End Function
+Public Function FilledValueCount() As Integer
+  FilledValueCount = filledValues
+End Function
+Public Function NextEmptyPosition() As position
+  Set NextEmptyPosition = New position
+  Dim row As Integer
+  Dim col As Integer
+
+  For row = 1 To 9
+    For col = 1 To 9
+      If Values(row, col) = 0 Then
+        NextEmptyPosition.row = row
+        NextEmptyPosition.col = col
+        Exit Function
+      End If
+    Next col
+  Next row
+End Function
+Private Sub ResetMap(Map() As Boolean)
+  Dim i As Integer
+  For i = 1 To 9
+    Map(i) = False
+  Next i
+End Sub
+
+
+
+
+
+

Class Modules/Position.cls

@@ -0,0 +1,14 @@
+VERSION 1.0 CLASS
+BEGIN
+  MultiUse = -1  'True
+END
+Attribute VB_Name = "Position"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Explicit
+
+'List of properties
+Public row As Integer
+Public col As Integer

Modules/SudokuSolver.bas

@@ -0,0 +1,44 @@
+Attribute VB_Name = "SudokuSolver"
+Option Explicit
+Public Sub Sudoku()
+    Dim initialPuzzle As node
+    Set initialPuzzle = View.Load()
+
+    Dim nodeList As New List
+    Call nodeList.Add(initialPuzzle)
+    Dim totalNodes As Integer
+    totalNodes = 1
+
+    Dim currentPuzzle As node
+    Dim solved As Boolean
+    solved = False
+
+    Dim bestSolution As Integer
+    bestSolution = initialPuzzle.FilledValueCount
+    Call View.Render(initialPuzzle, nodeList, totalNodes, bestSolution)
+
+    Do While nodeList.Length > 0 And Not solved
+        Set currentPuzzle = nodeList.PopNode
+        Dim position As position
+        Set position = currentPuzzle.NextEmptyPosition()
+
+        Dim value As Integer
+        For value = 1 To 9
+          Dim newPuzzle As node
+          Set newPuzzle = currentPuzzle.Clone
+          Call newPuzzle.SetValue(position.row, position.col, value)
+          If newPuzzle.IsValidSudoku(position) Then
+            If newPuzzle.FilledValueCount > bestSolution Then
+              Call View.Render(newPuzzle, nodeList, totalNodes, bestSolution)
+              bestSolution = newPuzzle.FilledValueCount
+            End If
+            If newPuzzle.IsSolvedSudoku Then
+              Call View.Render(newPuzzle, nodeList, totalNodes, bestSolution)
+              solved = True
+            End If
+            Call nodeList.Add(newPuzzle)
+            totalNodes = totalNodes + 1
+          End If
+        Next value
+    Loop
+End Sub

Modules/View.bas

@@ -0,0 +1,37 @@
+Attribute VB_Name = "View"
+Option Explicit
+Public Function Load() As node
+  Set Load = New node
+  Dim row As Integer
+  Dim col As Integer
+
+  For row = 1 To 9
+    For col = 1 To 9
+      Call Load.SetValue(row, col, Cells(row, col))
+    Next col
+  Next row
+End Function
+Public Sub Render(puzzle As node, nodeList As List, totalNodes As Integer, bestSolution As Integer)
+  Dim row As Integer
+  Dim col As Integer
+  Dim value As Integer
+
+  For row = 1 To 9
+    For col = 1 To 9
+      value = puzzle.GetValue(row, col)
+      If value = 0 Then
+        Cells(row, col + 11) = ""
+      Else
+        Cells(row, col + 11) = value
+      End If
+    Next col
+  Next row
+
+  'Print stats
+  Cells(11, 1) = "Total number of nodes: " & totalNodes
+  Cells(12, 1) = "Current number of nodes: " & nodeList.Length
+  Cells(13, 1) = "% Complete: " & 100 * bestSolution \ (9 * 9) & "%"
+  DoEvents
+End Sub
+
+

README.md

@@ -1,2 +1,6 @@
 # ExcelSudokuSolver
-Sudoku solver using Visual Basic for Applications (VBA) macro that can run in Excel
+Sudoku solver using Visual Basic for Applications (VBA) macro that can run in Excel.  
+Uses a branch & bound depth-first algorithm.  
+Screenshot below: original Puzzle to the left, solved puzzle to the right.  Stats for nerds at the bottom!
+
+![Alt text](image-1.png)