Task: 24 game








VB: Sub Rosetta_24game()

Dim Digit(4) As Integer, i As Integer, iDigitCount As Integer
Dim stUserExpression As String
Dim stFailMessage As String, stFailDigits As String
Dim bValidExpression As Boolean, bValidDigits As Boolean, bValidChars As Boolean
Dim vResult As Variant, vTryAgain As Variant, vSameDigits As Variant


GenerateNewDigits:
    For i = 1 To 4
        Digit(i) = [randbetween(1,9)]
    Next i


GetUserExpression:
    bValidExpression = True
    stFailMessage = ""
    stFailDigits = ""
    stUserExpression = InputBox("Enter a mathematical expression which results in 24, using the following digits: " & _
        Digit(1) & ", " & Digit(2) & ", " & Digit(3) & " and " & Digit(4), "Rosetta Code | 24 Game")


    bValidDigits = True
    stFailDigits = ""
    For i = 1 To 4
        If InStr(stUserExpression, Digit(i)) = 0 Then
            bValidDigits = False
            stFailDigits = stFailDigits & " " & Digit(i)
        End If
    Next i
    If bValidDigits = False Then
        bValidExpression = False
        stFailMessage = "Your expression excluded the following required digits: " & stFailDigits & vbCr & vbCr
    End If


    bValidDigits = True
    stFailDigits = ""
    For i = 1 To Len(stUserExpression)
        If InStr("0123456789+-*/()", Mid(stUserExpression, i, 1)) = 0 Then
            bValidDigits = False
            stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
        End If
    Next i
    If bValidDigits = False Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained invalid characters:" & stFailDigits & vbCr & vbCr
    End If


    bValidDigits = True
    stFailDigits = ""
    iDigitCount = 0
    For i = 1 To Len(stUserExpression)
        If Not InStr("0123456789", Mid(stUserExpression, i, 1)) = 0 Then
            iDigitCount = iDigitCount + 1
            If IsError(Application.Match(--(Mid(stUserExpression, i, 1)), Digit, False)) Then
                bValidDigits = False
                stFailDigits = stFailDigits & " " & Mid(stUserExpression, i, 1)
            End If
        End If
    Next i
    If iDigitCount > 4 Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained more than 4 digits" & vbCr & vbCr
    End If
        If iDigitCount < 4 Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained less than 4 digits" & vbCr & vbCr
    End If
    If bValidDigits = False Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained invalid digits:" & stFailDigits & vbCr & vbCr
    End If


    bValidDigits = True
    stFailDigits = ""
    For i = 11 To 99
        If Not InStr(stUserExpression, i) = 0 Then
            bValidDigits = False
            stFailDigits = stFailDigits & " " & i
        End If
    Next i
    If bValidDigits = False Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression contained invalid numbers:" & stFailDigits & vbCr & vbCr
    End If


    On Error GoTo EvalFail
    vResult = Evaluate(stUserExpression)
    If Not vResult = 24 Then
        bValidExpression = False
        stFailMessage = stFailMessage & "Your expression did not result in 24. It returned: " & vResult
    End If


    If bValidExpression = False Then
        vTryAgain = MsgBox(stFailMessage & vbCr & vbCr & "Would you like to try again?", vbCritical + vbRetryCancel, "Rosetta Code | 24 Game | FAILED")
            If vTryAgain = vbRetry Then
                vSameDigits = MsgBox("Do you want to use the same numbers?", vbQuestion + vbYesNo, "Rosetta Code | 24 Game | RETRY")
                If vSameDigits = vbYes Then
                    GoTo GetUserExpression
                Else
                    GoTo GenerateNewDigits
                End If
            End If
    Else
        vTryAgain = MsgBox("You entered: " & stUserExpression & vbCr & vbCr & "which resulted in: " & vResult, _
            vbInformation + vbRetryCancel, "Rosetta Code | 24 Game | SUCCESS")
        If vTryAgain = vbRetry Then
            GoTo GenerateNewDigits
        End If
    End If
    Exit Sub
EvalFail:
    bValidExpression = False
    vResult = Err.Description
    Resume
End Sub