Open the VB Editor
Use the Insert Menu to insert a Module (not a ClassModule)
Copy paste the first bit of (improved) code from below into that.
Use the Project Explorer to open the Microsoft Excel Object called ThisWorkbook and copy/paste the second bit of code into that.
Close the VB Editor.

You should now have a workbook that acts like the attached.

in a normal module[VBA]Function SUBVALS(inRange As Range) As String
Application.Volatile
With Application.Caller.Validation
SUBVALS = .ErrorMessage
.InputMessage = inRange.Range("a1").Address(, , , True)
End With
End Function

Function ValuesInsteadOfPrecedents(ByVal inRange As Range) As String
Rem returns the formula of inRange with value replacing references
Dim PrecedentsRRay As Variant
Dim onePrecedent As Variant
Dim formulaString As String
If inRange.Cells.Count = 1 Then
ValuesInsteadOfPrecedents = inRange.Formula
PrecedentsRRay = ArrayOfPrecedents(inRange)
If UBound(PrecedentsRRay) = 0 Then Exit Function
If PrecedentsRRay(1) Is Nothing Then Exit Function
For Each onePrecedent In PrecedentsRRay
ValuesInsteadOfPrecedents = SwapValueForRange(ValuesInsteadOfPrecedents, onePrecedent)
Next onePrecedent
End If
End Function

Function SwapValueForRange(formulaStr As String, replaceRange As Variant) As String
Rem replace one precedent with its value in the formula string
Const Indicator As String = "\"
Dim testStr As String
Dim replacementString As String

If replaceRange.Cells.Count = 1 Then
replacementString = Indicator & CStr(replaceRange.Text)
Else
replacementString = Indicator & CStr(replaceRange.Range("A1").Text) & ":" & Indicator
With replaceRange
replacementString = replacementString & CStr(.Cells(.Rows.Count, .Columns.Count).Text)
End With
End If

formulaStr = Application.Substitute(formulaStr, "$", vbNullString)
SwapValueForRange = formulaStr

SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(False, False, xlA1, True), replacementString)
If SwapValueForRange = formulaStr Then
testStr = replaceRange.Address(False, False, xlA1, True)
testStr = Left(testStr, InStr(testStr, "[") - 1) & Mid(testStr, InStr(testStr, "]") + 1)
SwapValueForRange = Application.Substitute(SwapValueForRange, testStr, replacementString)
If SwapValueForRange = formulaStr Then
SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(False, False), replacementString)
End If
End If
End Function

Function ArrayOfPrecedents(homeCell As Range) As Variant
Rem returns an array of all of the homeCell's precedent
Dim startPlace As Range, startWindow As Window
Dim outRRay() As Range
Dim i As Long, pointer As Long
Set startPlace = Selection
Set startWindow = ActiveWindow
If homeCell.HasFormula Then
ReDim outRRay(1 To Len(homeCell.Formula))
On Error Resume Next
homeCell.Parent.ClearArrows

Application.EnableSound = False
homeCell.ShowPrecedents: Rem problem Line
Application.EnableSound = True
On Error GoTo 0

On Error GoTo FoundAllExternalPrecedents

For i = 1 To UBound(outRRay)
homeCell.NavigateArrow True, 1, i
If Selection.Address(, , , True) = homeCell.Address(, , , True) Then
Rem closedRef
Else
pointer = pointer + 1
Set outRRay(pointer) = Selection
End If
Next i

FoundAllExternalPrecedents:
On Error GoTo 0

For i = 2 To UBound(outRRay)
homeCell.NavigateArrow True, i, 1
If Selection.Address(, , , True) = homeCell.Address(, , , True) Then Exit For
pointer = pointer + 1
Set outRRay(pointer) = Selection
Next i

On Error Resume Next
homeCell.Parent.ClearArrows
On Error GoTo 0

ReDim Preserve outRRay(1 To Application.Max(1, pointer))
ArrayOfPrecedents = outRRay
Else
ReDim outRRay(0 To 0)
ArrayOfPrecedents = outRRay
End If
startWindow.Activate
Application.Goto reference:=startPlace, Scroll:=False
End Function[/VBA]
In ThisWorkbook module[VBA]Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim restoreCalc As Long: restoreCalc = Application.Calculation
Dim oneCell As Range
Application.EnableEvents = False
Application.Calculation = xlManual
Application.ScreenUpdating = False

On Error Resume Next
For Each oneCell In Sh.Cells.SpecialCells(xlCellTypeFormulas)
If oneCell.Formula Like "*SUBVALS(*" Then
With oneCell.Validation
.ErrorMessage = ValuesInsteadOfPrecedents(Range(.InputMessage))
End With
End If
Next oneCell
On Error GoTo 0
Calculate

Application.ScreenUpdating = True
Application.Calculation = restoreCalc
Application.EnableEvents = True
End Sub[/VBA]