Mine Sweeper in Excel Solver

[pongkhi]

Hello Trying to write a function that solve Minesweeper game in this 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)
    ' use padding
    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
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With topLeft.Offset(i - 1, j - 1).Borders(xlDiagonalDown)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 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