4d6 drop lowest VBA

I wrote a method which you'll be able to re-use later with more dices or a different number of dices you want to keep. I included a proof of concept so you can see it works.

Sub Dices()
    'Some random numbers
    Dim Dice1, Dice2, Dice3, Dice4 As Integer
    Dice1 = Int(6 * Rnd + 1)
    Dice2 = Int(6 * Rnd + 1)
    Dice3 = Int(6 * Rnd + 1)
    Dice4 = Int(6 * Rnd + 1)
    
    'The rest is coded as if I didn't knew that you're throwing 4 dices but want to keep only 3, so it can be used in another context for future needs
    'Compare and keep best three
    Dim numberOfDicesToKeep As Integer
    numberOfDicesToKeep = 3
    ReDim highestDicesArray(numberOfDicesToKeep) As Integer ' allocating the exact memory for the array
    
    highestDicesArray = KeepDices(numberOfDicesToKeep, Dice1, Dice2, Dice3, Dice4)
    
    ' Proof of concept, not to paste in your solution
    ' You can use it at first so you can see what happens under the hood, what dices were kept from what selection
    Dim values As String
    Dim i As Integer
    
    values = "Dices : " & CStr(Dice1) & " " & CStr(Dice2) & " " & CStr(Dice3) & " " & CStr(Dice4) & vbCrLf & "Kept  : "
    For i = 0 To numberOfDicesToKeep - 1
        values = values & highestDicesArray(i) & " "
    Next i
    
    MsgBox (values)
End Sub

' This method will compare the numbers you gave it and keep only the biggest ones
' "ParamArray" means that you can put as many parameters as you want here, like 20 dices if you wish
Function KeepDices(numberOfDicesToKeep As Integer, ParamArray dices() As Variant) As Variant
    ReDim result(numberOfDicesToKeep - 1) As Integer
    Dim i, j, lowestDiceIndex As Integer

    For i = 0 To UBound(dices)
        If i < numberOfDicesToKeep Then
            result(i) = dices(i)
        Else
            lowestDiceIndex = -1
            
            For j = 0 To numberOfDicesToKeep - 1
                If dices(i) > result(j) Then
                    If lowestDiceIndex = -1 Then
                        lowestDiceIndex = j
                    Else
                        If result(lowestDiceIndex) > result(j) Then
                            lowestDiceIndex = j
                        End If
                    End If
                End If
            Next j
            
            If lowestDiceIndex <> -1 Then
                result(lowestDiceIndex) = dices(i)
            End If
        End If
    Next i
    
    KeepDices = result
End Function

Have fun!

For the fun, if you wish a truly random count, you can use the ThrowDice demo function from my project VBA.Random and the QuickSort function from the ArraySorting module found at VBA.Round and combine these:

' Sum the top pip values of a single throw of dice.
' If a top count is not specified, the pip values of all the dice are summed.
'
' 2020-10-17. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DiceSum( _
    ByVal DieCount As Integer, _
    Optional ByVal TopCount As Integer) _
    As Integer
    
    Dim Throws()    As Integer
    Dim Dice()      As Integer
    Dim TopSum      As Integer
    Dim Index       As Integer
    Dim Count       As Integer
    
    If TopCount <= 0 Then
        TopCount = DieCount
    End If
    
    ' Retrieve two-dimension array with one throw of the dice.
    Throws = ThrowDice(1, DieCount)
    
    ' Convert array to one dimension only
    ReDim Dice(LBound(Throws, 1) To UBound(Throws, 1))
    For Index = LBound(Dice) To UBound(Dice)
        Dice(Index) = Throws(Index, 1)
    Next
    ' Sort the dice by the pip values ascending.
    QuickSort Dice
    
    ' Sum the top pip values
    Index = UBound(Dice)
    While Index >= LBound(Dice) And Count < TopCount
        TopSum = TopSum + Dice(Index)
        Index = Index - 1
        Count = Count + 1
    Wend
    
    DiceSum = TopSum

End Function