Excel Sub Procedure

Question

Consider a game of three players. During a game, each player will roll two dices and his total will be recorded. Then points will be awarded based on the following rules:

• The player with the highest total will earn 3 points, the player with the second highest total will earn 1 point, and the player who comes last will earn nothing.

• If it is a draw between all three players, then each player will earn 1 point.

• If it is a draw between the top two players, then each of them will earn 2 points while the last player will earn nothing.

• If it is a draw between the bottom two players, then each of them will earn nothing while the top player will earn 3 points.

• Assume that the dices are regular six-sided fair dices.

Let's call the players P1, P2, and P3, respectively. Write an Excel Sub Procedure that simulates playing the game 1000 times.

Sub Sim()

Call VBA.Randomize

    For i = 1 To 1000
        Cells(i + 1, 1) = i
        For j = 2 To 4
            x = Int(1 + (Rnd * 6))
            y = Int(1 + (Rnd * 6))
            Cells(i + 1, j) = "(" & x & " , " & y & ")"
            Cells(i + 1, j + 3) = x + y
            If Cells(i + 1, j + 3) > Max Then
              Cells(i + 1, j + 3) = "3"
            ElseIf Cells(i + 1, j + 3) < Min Then
              Cells(i + 1, j + 3) = "0"
            ElseIf Cells(i + 1, j + 3) = Min Then
              Cells(i + 1, j + 3) = "1"
            End If
        Next

?????? how to continue in in order to get results as attached below:

Expected result:

Answer 1

I'd suggest using an array to hold the outcomes, and then using a full set of comparisons to decide the points awarded to each player. Below is a piece of code that works through the different possible outcomes. I am sure that it could be streamlined a bit!!

Dim objXLSheet As Worksheet
Dim astrOutput(1 To 3) As String
Dim aintDice(1 To 3) As Integer
Dim aintScore(1 To 3) As Integer
Dim intLoop1 As Integer
Dim intTemp1 As Integer
Dim intTemp2 As Integer

Set objXLSheet = ActiveSheet
Randomize
For intLoop1 = 1 To UBound(aintDice)
    intTemp1 = Int(1 + (Rnd * 6))
    intTemp2 = Int(1 + (Rnd * 6))
    astrOutput(intLoop1) = "(" & intTemp1 & "," & intTemp2 & ")"
    aintDice(intLoop1) = intTemp1 + intTemp2
Next intLoop1
If (aintDice(1) = aintDice(2)) And (aintDice(1) = aintDice(3)) Then '   all three scores are the same
    aintScore(1) = 1: aintScore(2) = 1: aintScore(3) = 1
ElseIf (aintDice(1) > aintDice(2)) And (aintDice(1) > aintDice(3)) Then '   player 1 wins outright
    If aintDice(2) = aintDice(3) Then
        aintScore(1) = 3: aintScore(2) = 0: aintScore(3) = 0
    ElseIf aintDice(2) > aintDice(3) Then
        aintScore(1) = 3: aintScore(2) = 1: aintScore(3) = 0
    ElseIf aintDice(3) > aintDice(2) Then
        aintScore(1) = 3: aintScore(2) = 0: aintScore(3) = 1
    End If
ElseIf (aintDice(2) > aintDice(1)) And (aintDice(2) > aintDice(3)) Then '   player 2 wins outright
    If aintDice(1) = aintDice(3) Then
        aintScore(1) = 0: aintScore(2) = 3: aintScore(3) = 0
    ElseIf aintDice(1) > aintDice(3) Then
        aintScore(1) = 1: aintScore(2) = 3: aintScore(3) = 0
    ElseIf aintDice(3) > aintDice(1) Then
        aintScore(1) = 0: aintScore(2) = 3: aintScore(3) = 1
    End If
ElseIf (aintDice(3) > aintDice(1)) And (aintDice(3) > aintDice(2)) Then '   player 3 wins outright
    If aintDice(1) = aintDice(2) Then
        aintScore(1) = 0: aintScore(2) = 0: aintScore(3) = 3
    ElseIf aintDice(1) > aintDice(2) Then
        aintScore(1) = 1: aintScore(2) = 0: aintScore(3) = 3
    ElseIf aintDice(2) > aintDice(1) Then
        aintScore(1) = 0: aintScore(2) = 1: aintScore(3) = 3
    End If
ElseIf aintDice(1) = aintDice(2) Then   '   players 1 and 2 tie for the win
    aintScore(1) = 2: aintScore(2) = 2: aintScore(3) = 0
ElseIf aintDice(1) = aintDice(3) Then   '   players 1 and 3 tie for the win
    aintScore(1) = 2: aintScore(2) = 0: aintScore(3) = 2
ElseIf aintDice(2) = aintDice(3) Then   '   players 2 and 3 tie for the win
    aintScore(1) = 0: aintScore(2) = 2: aintScore(3) = 2
End If

objXLSheet.Cells(lngGame + 1, 1) = lngGame
For intLoop1 = 1 To UBound(aintDice)
    objXLSheet.Cells(lngGame + 1, 1 + intLoop1) = astrOutput(intLoop1)
    objXLSheet.Cells(lngGame + 1, 4 + intLoop1) = aintScore(intLoop1)
    objXLSheet.Cells(lngGame + 1, 7 + intLoop1) = aintDice(intLoop1)
Next intLoop1

Regards,