Attribute VB_Name = "Module1"

'==========================================================
'                                         Muhammad Abubakar
'                                     <joehacker@yahoo.com>
'                                   <http://go.to/abubakar>
'==========================================================
'You can use the code as u like in your projects but please
'give credit where credit is due :)
'
'======================================= November 14th 2014 
' Added operators:
'     "\" (integer division) and "%" (division remainder)
'                                  By y.monmagnon@wanadoo.fr
'===========================================================

Option Explicit

Public Function parse(expr As String) As Double
    Dim i As Double, a As String
    Dim start As Double, endat As Double
    expr = Trim(expr)
    If InStr(expr, "(") <> 0 Then
        i = 1
        While (InStr(expr, "(") <> 0)
            a = Mid(expr, i, 1)
            If a = "(" Then
                start = i
            ElseIf a = ")" Then
                If start = 0 Then
                    MsgBox "Invalid Syntax."
                    Exit Function
                End If
                endat = i
                i = Val(givePrecedence(Mid(expr, start + 1, endat - start - 1)))
                expr = Left(expr, start - 1) & Str(i) & Right(expr, Len(expr) - endat)
                start = 0: endat = 0
                i = 0
            End If
            i = i + 1
        Wend
    End If
    If expr <> "" Then
        parse = Val(givePrecedence(expr))
    Else
        parse = i
    End If
End Function


Private Function Eval(temp As String, sign As String, prevExpr As String) As String
    Select Case sign
        Case "+":
            Eval = Str(Val(prevExpr) + Val(temp))
        Case "-":
            Eval = Str(Val(prevExpr) - Val(temp))
        Case "*":
            Eval = Str(Val(prevExpr) * Val(temp))
        Case "/":
            If Val(temp) = 0 Then
                MsgBox "Divide by zero" & vbCrLf & "Ignored", vbCritical, "MathParser"
            Else
                Eval = Str(Val(prevExpr) / Val(temp))
            End If
        Case "^":
            Eval = Str(Val(prevExpr) ^ Val(temp))
        Case "\":
            Eval = Str(Val(prevExpr) \ Val(temp))
        Case "%":
            Eval = Str(Val(prevExpr) Mod Val(temp))
    End Select
End Function

Private Function givePrecedence(expr As String) As String
    Dim X As Integer, temp As String
   
    Do While (InStr(expr, "!") <> 0 Or InStr(expr, "*") <> 0 Or InStr(expr, "/") <> 0 Or InStr(expr, "^") <> 0 _
        Or InStr(expr, "+") <> 0 Or InStr(expr, "-") <> 0 Or InStr(expr, "\") <> 0 Or InStr(expr, "%") <> 0)
        DoEvents
        X = InStr(expr, "!")
        If X <> 0 Then
            temp = solveFor("!", expr)
        Else
            X = InStr(expr, "^")
            If X <> 0 Then
                temp = solveFor("^", expr)
            Else
                X = InStr(expr, "/")
                If X <> 0 Then
                    temp = solveFor("/", expr)
                Else
                    X = InStr(expr, "\")
                    If X <> 0 Then
                        temp = solveFor("\", expr)
                    Else
                        X = InStr(expr, "%")
                        If X <> 0 Then
                            temp = solveFor("%", expr)
                        Else
                            X = InStr(expr, "*")
                            If X <> 0 Then
                                temp = solveFor("*", expr)
                            Else
                                X = InStr(expr, "+")
                                If X <> 0 Then
                                    temp = solveFor("+", expr)
                                Else
                                    X = InStr(expr, "-")
                                    If X <> 0 Then
                                        temp = solveFor("-", expr)
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
        If temp = "" Then
            Exit Do
        Else
            expr = temp
        End If
    Loop
    givePrecedence = expr
   
End Function
Private Function GetNumFrom(Pos As Integer, expr As String) As String
    Dim i As Integer, temp As String
    Dim a As String
    If Pos <= Len(expr) Then
        For i = Pos To Len(expr)
        '{
            a = Mid(expr, i, 1)
            If Asc(a) >= 48 And Asc(a) <= 58 Or a = " " Or a = "." _
                Or ((a = "-" Or a = "+") And Trim(temp) = "") Then
                temp = temp & a
            Else
                If LCase(a) = "e" Then
                temp = temp & "E" & GetNumFrom(i + 1, expr) 'Recursion
                i = Len(expr)
                Else
'                    MsgBox "Invalid syntax", vbCritical, "MathParser"
                'wrong syntax, u can handle error as you like
                End If
            i = Len(expr)
            End If
        Next
        '}
    GetNumFrom = temp
    End If
End Function
Private Function solveFor(sign As String, expr As String) As String
        '{
            Dim X As Integer, start As Integer, endat As Integer
            Dim temp As String, a As String, i As Integer
            start = 1
            X = InStr(expr, sign)
            If sign <> "!" Then
                If sign = "+" Or sign = "-" Then
                    a = GetNumFrom(1, expr)
                    If Len(a) = Len(expr) Then
                        solveFor = ""
                        Exit Function
                    End If
                    temp = GetNumFrom(Len(a) + 1, expr)
                    If Sgn(Val(temp)) < 0 Then
                        sign = "-"
                    Else: sign = "+"
                    End If
                    X = InStr(Len(a), expr, sign)
                    endat = Len(a) + Len(temp)
                    temp = Eval(GetNumFrom(X + 1, expr), sign, a)
                    expr = Left(expr, start - 1) & temp & Right(expr, Len(expr) - endat)
                    solveFor = expr
                    Exit Function
                   
                End If
            End If
            'i = InStr(x + 1, expr, sign)
           
            For i = X - 1 To 1 Step -1 'going back
                a = Mid(expr, i, 1)
                If Asc(a) >= 48 And Asc(a) <= 58 Or a = " " Or a = "." Or LCase(a) = "e" Then
                    temp = a & temp
                Else
                    If (a = "-" Or a = "+") And i - 1 > 0 Then
                        If Mid(expr, i - 1, 1) = "e" Then
                            temp = a & temp
                        Else
                            start = i + 1
                            i = 1
                        End If
                    Else
                        start = i + 1
                        i = 1
                    End If
                End If
            Next
            If Trim(temp) <> "" Then
                'solving for factorial
                If sign = "!" Then
                    If Int(Val(temp)) <> Val(temp) Then
                    MsgBox "Invalid syntax", vbCritical, "MathParser"
                    
                        'wrong syntax, handle it in whatever way u awnt
                    Else
                        expr = Left(expr, start - 1) & Str(fact(Val(temp))) & Right(expr, Len(expr) - X)
                        solveFor = expr
                    End If
                Else
                    'its not a factorial calculations
                    endat = X + Len(GetNumFrom(X + 1, expr))
                    temp = Eval(GetNumFrom(X + 1, expr), sign, temp)
                    expr = Left(expr, start - 1) & temp & Right(expr, Len(expr) - endat)
                    'Job done, go back
                    solveFor = expr
                End If
            Else
                solveFor = ""
            End If
           
        '}

End Function
'Algo for factorial
Private Function fact(num As Integer) As Double
    Dim b As Double
    b = 1
    For num = 1 To num
        b = b * num 'I wish I could write it as b * = num :(
    Next
    fact = b

End Function