Option Explicit

Public Function EvaluateFormla(cell As Range) As String

Dim wb As Workbook
Dim sh As Worksheet
Dim col
Dim itm
Dim frm As String
Dim rng As Range

frm = cell.formula

col = CellPrecedents(cell)
For Each itm In col
    If LenB(itm) <> 0 Then
        Set rng = Range(itm)
        frm = Replace(frm, itm, rng.Value2)
    End If
Next

EvaluateFormla = frm

End Function

Public Function CellPrecedents(cell As Range) As Variant
    Dim resultRanges As New Collection
    If cell.Cells.count <> 1 Then GoTo exit_CellPrecedents
    If cell.HasFormula = False Then GoTo exit_CellPrecedents

    Dim formula As String
    formula = Mid(cell.formula, 2, Len(cell.formula) - 1)

    If IsRange(formula) Then
        resultRanges.Add Range(formula), 1
    Else
        Dim elements() As String
        'Debug.Print formula & " --> "
        formula = Replace(formula, "(", "")
        formula = Replace(formula, ")", "")
        'Debug.Print formula & " --> "
        elements() = SplitMultiDelims(formula, "+-*/\^")
        Dim n As Long, count As Integer
        For n = LBound(elements) To UBound(elements)
            If IsRange(elements(n)) Then
                'ACTUALLY JUST DO A REDIM PRESERVE HERE!!!!
                count = count + 1
                'resultRanges.Add Range(Trim(elements(n)))  '<---  Do **NOT** store as a range, as that gets automatically Eval()'d
                resultRanges.Add Trim(elements(n))
            End If
        Next
    End If

    Dim resultRangeArray() As Variant
    ReDim resultRangeArray(resultRanges.count)
    Dim i As Integer
    For i = 1 To resultRanges.count
        resultRangeArray(i) = CStr(resultRanges(i))  '// have to store as a string so Eval() doesn't get invoked (I think??)
    Next

    CellPrecedents = resultRangeArray

exit_CellPrecedents:
    Exit Function
End Function

Public Function IsRange(var As Variant) As Boolean
    On Error Resume Next
    Dim rng As Range: Set rng = Range(var)
    If Err.Number = 0 Then IsRange = True
End Function

Function SplitMultiDelims(Text As String, DelimChars As String) As String()
'''
'Function to split a string at multiple charachters
'Use like SplitMultiDelims2("This:is-a,test string", ":-,")
'Returns an array, in that example SplitMultiDelims2("This:is-a,test string", ":-,")(4) would be "test string"
'''
Dim bytes() As Byte
Dim delims() As Byte
Dim i As Long, aub As Long, ub As Long
Dim stack As String
Dim t() As String
Dim tLen As Long
tLen = Len(Text)
If tLen = 0 Then
    Exit Function
End If
ReDim t(1 To tLen) 'oversize array to avoid Redim Preserve too often
bytes = StrConv(Text, vbFromUnicode)
delims = StrConv(DelimChars, vbFromUnicode)
ub = UBound(bytes)
For i = 0 To ub
    If Contains(delims, bytes(i)) Then
        aub = aub + 1
        t(aub) = stack
        stack = ""
    Else
        stack = stack & Chr(bytes(i))
    End If
Next i
t(aub + 1) = stack
ReDim Preserve t(1 To aub + 1) 'Works marginally faster if you delete this line,
    'however it returns an oversized array (which is a problem if you use UBOUND of the result,
    'but fine if you are just looking up an indexed value like the 5th string)
SplitMultiDelims = t
End Function

Function Contains(arr, v As Byte) As Boolean 'checks if Byte v is contained in Byte array arr
Dim rv As Boolean, lb As Long, ub As Long, i As Long
    lb = LBound(arr)
    ub = UBound(arr)
    For i = lb To ub
        If arr(i) = v Then
            rv = True
            Exit For
        End If
    Next i
    Contains = rv
End Function