# Mine Sweeper in Excel Solver

#### pongkhi

##### New Member
Hello Trying to write a function that solve Minesweeper game in this code

Code:
``````Dim boardWidth As Integer
Dim targetMineDensity As Double
Dim eventHandlers As New Class1
Dim cellSelected As Boolean
Dim lastBoard() As Variant
Dim boardBackgroundColorIndex As Integer

Sub minesweeperInit(board As Variant, mineDensity As Double)
For i = 0 To boardWidth + 1
board(0, i) = 0
board(i, 0) = 0
board(boardWidth + 1, i) = 0
board(i, boardWidth + 1) = 0
Next i
Randomize
For i = 1 To boardWidth
For j = 1 To boardWidth
Dim tmp As Integer
tmp = CInt(Int((Rnd() + mineDensity)))
If tmp > 1 Then
tmp = 1
End If
board(i, j) = tmp
Next j
Next i
End Sub

Sub output_board(board As Variant, topLeft As Range)

For i = 1 To boardWidth
For j = 1 To boardWidth
topLeft.Offset(i - 1, j - 1).Value = board(i, j)
Next j
Next i
End Sub

Function mineDensity(board As Variant) As Double
Dim density As Double
density = 0
For i = 1 To boardWidth
For j = 1 To boardWidth
If board(i, j) = 1 Then
density = density + 1
End If
Next j
Next i

mineDensity = density / (boardWidth * boardWidth)
End Function

Sub translateBoardToDisplay(board As Variant, display As Variant)
For i = 1 To boardWidth
For j = 1 To boardWidth
Dim surrMine As Integer
surrMine = board(i - 1, j - 1) + board(i - 1, j) + board(i - 1, j + 1) + _
board(i, j - 1) + board(i, j + 1) + board(i + 1, j - 1) + _
board(i + 1, j) + board(i + 1, j + 1)
If board(i, j) = 1 Then
display(i, j) = -1
Else
display(i, j) = surrMine
End If
Next j
Next i
End Sub

Sub outputDisplay(display As Variant, topLeft As Range, Optional deactivateMines As Boolean = False)
For i = 1 To boardWidth
For j = 1 To boardWidth
With topLeft.Offset(i - 1, j - 1).Borders(xlDiagonalUp)
.LineStyle = xlNone
End With
With topLeft.Offset(i - 1, j - 1).Borders(xlDiagonalDown)
.LineStyle = xlNone
End With
If display(i, j) = -1 Then
' bomb
topLeft.Offset(i - 1, j - 1).Value = "B"
topLeft.Offset(i - 1, j - 1).Interior.ColorIndex = 3
If deactivateMines Then
With topLeft.Offset(i - 1, j - 1).Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
With topLeft.Offset(i - 1, j - 1).Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
End If
ElseIf display(i, j) > 0 Then
topLeft.Offset(i - 1, j - 1).Value = display(i, j)
topLeft.Offset(i - 1, j - 1).Interior.ColorIndex = boardBackgroundColorIndex
Else
topLeft.Offset(i - 1, j - 1).ClearContents
topLeft.Offset(i - 1, j - 1).Interior.ColorIndex = boardBackgroundColorIndex
End If
Next j
Next i
End Sub

Function validMineDensitySetting() As Double
If IsNumeric(Range("A12").Value) Then
Dim density As Double
density = Range("A12").Value
If density < 0.04 Or density > 0.65 Then
MsgBox ("Invalid mine density value: " & density & "!")
validMineDensitySetting = -0.99
Else
validMineDensitySetting = density
End If
Else
MsgBox ("Mine density (cell A12) must be a Double")
validMineDensitySetting = -0.97
End If
End Function

Sub minesweeperStart()
boardWidth = 5
boardBackgroundColorIndex = 19
Dim board() As Integer
ReDim board(boardWidth + 2, boardWidth + 2)

targetMineDensity = validMineDensitySetting()
If targetMineDensity < 0 Then
Exit Sub
End If
Dim bMineDensity As Double
Dim numTries As Integer
numTries = 0
bMineDensity = -1#
Do While bMineDensity > targetMineDensity * 1.1 Or _
bMineDensity < targetMineDensity * 0.97 - 0.039
If numTries > 400 Then
MsgBox "Unable to generate a board with the specified mine density"
Exit Sub
End If

numTries = numTries + 1
Call minesweeperInit(board, targetMineDensity)
bMineDensity = mineDensity(board)
Loop

'Call output_board(board, Range("B9"))

Dim display() As Integer
ReDim display(boardWidth + 2, boardWidth + 2)
Call translateBoardToDisplay(board, display)
'Call outputDisplay(display, Range("B2"))
Call minesweeper_play(board, display)
End Sub

Sub showLosingMsg()
MsgBox "You lose! Better luck next time."
End Sub

Sub minesweeper_play(board As Variant, display As Variant)
Set eventHandlers.appEvent = Application
Dim location As Range
Set location = Range("B2")
Dim numBombs As Integer

For i = 1 To boardWidth
For j = 1 To boardWidth
If board(i, j) = 1 Then
numBombs = numBombs + 1
End If
location.Offset(i - 1, j - 1).Borders(xlDiagonalDown).LineStyle = xlNone
location.Offset(i - 1, j - 1).Borders(xlDiagonalUp).LineStyle = xlNone
location.Offset(i - 1, j - 1).ClearContents
location.Offset(i - 1, j - 1).Interior.ColorIndex = 48
Next j
Next i

Dim numRevealedCells As Integer
Dim revealedRow As Integer
Dim revealedCol As Integer
numRevealedCells = 0
Dim won As Boolean

won = False

Do While numRevealedCells < boardWidth * boardWidth - numBombs
Do
eventHandlers.cellClicked = False
eventHandlers.cellRClicked = False
Do While Not eventHandlers.cellClicked
DoEvents
If eventHandlers.cellRClicked Then
If eventHandlers.rClickedCell.Row = 1 And eventHandlers.rClickedCell.Column = 7 Then
' exit game
showLosingMsg
Call outputDisplay(display, location)
GoTo finalize
End If
End If

Loop

Dim revealedCell As Range
Set revealedCell = eventHandlers.clickedCell

revealedRow = revealedCell.Row - location.Row + 1
revealedCol = revealedCell.Column - location.Column + 1

'MsgBox "after clearcontents. " & revealedRow & "," & revealedCol
If revealedRow >= 1 And revealedRow <= boardWidth And _
revealedCol >= 1 And revealedCol <= boardWidth Then
' valid cell
If revealedCell.Interior.ColorIndex = 48 Then
numRevealedCells = numRevealedCells + 1
revealedCell.ClearContents
If display(revealedRow, revealedCol) = -1 Then
revealedCell.Value = "B"
revealedCell.Interior.ColorIndex = 3
showLosingMsg
Call outputDisplay(display, location)
GoTo finalize
Else
If display(revealedRow, revealedCol) > 0 Then
revealedCell.Value = display(revealedRow, revealedCol)
End If
revealedCell.Interior.ColorIndex = boardBackgroundColorIndex
End If
End If
Exit Do
End If
Loop Until False
Loop

MsgBox "You win this one!"
Call outputDisplay(display, location, True)

finalize:
ReDim lastBoard(boardWidth + 2, boardWidth + 2)
'lastBoard = board
'MsgBox "done"
End Sub

Sub testClick()
If Range("C3").Interior.ColorIndex = 48 Then
Range("C3").Select
Else
Range("C4").Select
End If

End Sub``````

and here's my code but it can only generate a random cell

Function nextSafeCell() As Range

Dim RNG As Range
Set RNG = Range("b2:f6")

Dim randomCell As Long
randomCell = Int(Rnd * RNG.Cells.Count) + 1

set nextsafecell = RNG.Cells(randomCell)

End Function

Sub revealNextSafeCell()
Dim nextCell As Range
Set nextCell = nextSafeCell()
Range("A2").Select
nextCell.Select
End Sub

Big Thanks for helps

Last edited:

### Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Replies
3
Views
74
L
Replies
5
Views
187
Legacy 502047
L
Replies
3
Views
109
Replies
1
Views
72
Replies
5
Views
160

1,191,229
Messages
5,985,406
Members
439,962
Latest member
max_york

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back