Showing Formula with values in other language

[mrd78]

hello all.

i am looking for a solution for showing the formula in a cell as text but with the original values. for example: if cell A1=20 ; B1=30 ; C1=A1+B1, the cell C1 will return the value 50. what i need is to show the fomula in C1.

i know there are function available which will return "=A1+B1"' but i need it to show "=20+30". is it possible?

thank you.
Albert.

[tpoynton]

Welcome!

a slightly different approach that does give you the end result.

You could create a function: put the code below in a module:

[vba]
Function showValues(val1 As Range, val2 As Range) As String
showValues = "=" & val1 & "+" & val2
End Function
[/vba]
in a cell (D1 in your example), put in the formula:

=showValues(A1,B1)

there might be a better way to approach this, but it's a start!

This will only work with addition...I'm sure there's a way to pull apart the formula and give you this info; please describe the full scope of how it might be used!

EDIT - looks like this might be pretty easily edited to suit your needs

[mrd78]

first of all l want to thank you for taking the time to help & how fast it was...
what i need is for explaining results on my papers. i am an accounting student, & i have to hand home work papers every time.

the numbers i show in my solution consist of all sorts of calculation, not just addition. therfore i need it to shoe the calculation i did with the true value of the cells in use.

anoter example. A1=40% ; B2=200 ; C1=100 ; D1=A1*B1+C1.

D1 will return 180 and i want to show th caclculation as "=40%*200+100

thanks

[mikerickson]

This UDF might help.
ValuesInsteadOfPrecedents(A1) will return the formula in A1 with cell references replaced with the values they represent.

If A1 holds =B1+C1
B1 holds 3
C1 holds 1
D1 holds 12

= ValuesInsteadOfPrecedents(A1) will return "=\3+\1"
(The \ differentiates between reference values and constants. eg. =B1+C1 >> "=\3+\1" vs. =B1+1 >> "=\3+1")

if a multicell range is in the formula, the values at the end points will be returned.

A1 holds =MAX(B1: D1)
B1 holds 3
C1 holds 1
D1 holds 12
ValuesInsteadOfPrecedents(A1) = "=MAX(\3:\12)"

Unfortunatly, the UDF uses NavigateArrows, which will not run when called from the spreadsheet. This UDF only works when called from VB.

If the precedent cells are restricted to the same sheet as the cell holding the formula, .DirectPrecedents could be used to make a spreadsheet compatible version.

[VBA]Function ValuesInsteadOfPrecedents(ByVal inRange As Range) As String
Rem main UDF
Dim PrecedentsRRay As Variant
Dim onePrecedent As Variant
Dim formulaString As String
If inRange.Cells.Count = 1 Then
formulaString = inRange.Formula
ValuesInsteadOfPrecedents = formulaString
PrecedentsRRay = ArrayOfPrecedents(inRange)
If UBound(PrecedentsRRay) = 0 Then Exit Function
If PrecedentsRRay(1) Is Nothing Then Exit Function
For Each onePrecedent In PrecedentsRRay
formulaString = SwapValueForRange(formulaString, onePrecedent)
Next onePrecedent
ValuesInsteadOfPrecedents = formulaString
End If
End Function

Function SwapValueForRange(formulaStr As String, replaceRange As Variant) As String
Rem subordinate
Dim testStr As String
Dim replacementString As String
If replaceRange.Cells.Count = 1 Then
replacementString = "\" & CStr(replaceRange.Value)
Else
replacementString = "\" & CStr(replaceRange.Range("A1").Value) & ":\"
With replaceRange
replacementString = replacementString & CStr(.Cells(.Rows.Count, .Columns.Count).Value)
End With
End If
SwapValueForRange = formulaStr

SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(True, True, xlA1, True), replacementString)
SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(True, False, xlA1, True), replacementString)
SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(False, True, xlA1, True), replacementString)
SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(False, False, xlA1, True), replacementString)

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

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

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

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

If SwapValueForRange = formulaStr Then
SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(True, True), replacementString)
SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(True, False), replacementString)
SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(False, True), replacementString)
SwapValueForRange = Application.Substitute(SwapValueForRange, replaceRange.Address(False, False), replacementString)
End If
End Function

Function ArrayOfPrecedents(homeCell As Range) As Variant
Rem subordinate
Dim outRRay() As Range
Dim i As Long, pointer As Long
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

ReDim Preserve outRRay(1 To Application.Max(1, pointer))
ArrayOfPrecedents = outRRay
Else
ReDim outRRay(0 To 0)
ArrayOfPrecedents = outRRay
End If
On Error Resume Next
homeCell.Parent.ClearArrows
On Error GoTo 0
End Function[/VBA]

(Windows users can use the vb function Replace instead of Application.Substitute)

There is an annoying feature to this function. See thread

[mikerickson]

Here's a way to use that UDF for a spreadsheet function.
Put this in a normal module
[VBA]Function SUBVALS(inRange As Range) As String
Application.Volatile
On Error Resume Next

With Application.Caller.Validation
SUBVALS = .ErrorMessage
.Delete
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertInformation, Operator:=xlBetween, Formula1:="=TRUE"
On Error GoTo 0
.InputMessage = inRange.Range("a1").Address(, , , True)
.ShowInput = False
.ShowError = False
.ErrorMessage = SUBVALS
End With
End Function[/VBA]
And this in the sheet's code module

Private Sub Worksheet_Calculate()
    Dim oneCell As Range
    On Error Resume Next
    If Me.Cells.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub
    
    For Each oneCell In Me.Cells.SpecialCells(xlCellTypeAllValidation)
        If oneCell.Formula Like "*SUBVALS(*" Then
            With oneCell.Validation
                .ErrorMessage = ValuesInsteadOfPrecedents(Range(.InputMessage))
            End With
        End If
    Next oneCell
    On Error GoTo 0
    Application.EnableEvents = False
    Calculate
    Application.EnableEvents = True
End Sub

Then, when put in a cell, =SUBVALS(A1) will return the formula in A1 with cell references replaced by values.
(note: SUBVALS will error if called from a VB routine)

[mrd78]

hello mike.

thanks for the code - i wish i knew what goes on in there...

i tried to apply the codes you gave me but i got lost.
i don't really know how to get it into excel - i don't know VB so i don't understand the difference between a normal module & a sheet's code module.
i can get to the VB window (Alt+F11), but there i'm lost.

if you could explain in a few simple steps what to do i will be grateful.

thanks again.

[mikerickson]

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]

[mikerickson]

What is going on in there is:
Let A1 contain =B1+C1 , B1 contain 2 & C1 contain 3

The function ValuesInsteadOfPrecedents(Range("A1")) will return the string "=\2+\3".
The first step in doing that is to call the function ArrayOfPrecidents(Range("A1")), which needs to show the precedent arrows to obtain its result.
However, functions called from a worksheet can not change the environment, eg. coloring cells or drawing arrows.

In order for the worksheet UDF SubVal to work, it must call a routine that won't work when called from a worksheet.

This work-around uses Public variables subValCollection and (boolean) CollectionHoldsValues and the Change event.

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

    Rem some code

    CollectionHoldsValue = True
    Calculate
    CollectionHoldsValue = False
End Sub

Since the change event happens AFTER the UDF has execuited, the sequence of events is

Function SubVal is run
some code is run
Function SubVal is run again

(pseudo-code)
Function SubVal(inputRange As Range) As String
    If CollectionHoldsValues Then
        SubVal = SubValCollection(inputRange.Address)
    Else
        SubValCollection.Add item:=inputRange, key:=inputRange.Address
        SubVal = "null"
    End If
End Function

On the first pass through SubVal, CollectionHoldsValues = False, and the second leg of the If executes, putting inputRange into the collection and returning a dummy value.
Then the Change event runs and <some code> takes inputRange out of the collection and replaces it with ValuesInsteadOfPrecedents(inputRange). Since this is not called from a worksheet, it runs properly.
With CollectionHoldsValue set to True, the Calculate triggers another run of SubVal, this time taking the first leg, which reads the return value from the collection.

The previous version used the memory locations for data validation to impliment a similar logic, but the Collection approach is more robust, adapting to inserted and deleted cells.

The actual code is

in a normal module

Public CollectionHoldsValues As Boolean
Public subValCollection As New Collection

Function SubVal(inputRange As Range) As String
    Application.Volatile
    On Error GoTo OutOfFtn
  
    If CollectionHoldsValues Then
        On Error Resume Next
        SubVal = subValCollection(inputRange.Range("A1").Address(, , , True))
        On Error GoTo 0
    Else
        On Error Resume Next
            subValCollection.Add Item:=inputRange.Range("a1"), key:=inputRange.Range("a1").Address(, , , True)
        On Error GoTo 0
        SubVal = "null"
    End If
Exit Function
OutOfFtn:
    SubVal = vbNullString
    On Error GoTo 0
End Function

in the ThisWorkbook code module

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim oneCell As Range, i As Long
Dim startPlace As Range, startWindow As Window
Dim newValue As String
If 0 < subValCollection.Count Then
    Set startPlace = Selection
    Set startWindow = ActiveWindow
    Application.EnableEvents = False

    For i = 1 To subValCollection.Count
        Set oneCell = subValCollection(i)
        newValue = ValuesInsteadOfPrecedents(oneCell)

        subValCollection.Remove oneCell.Address(, , , True)
        
        If subValCollection.Count = 0 Then
            subValCollection.Add Item:=newValue, key:=oneCell.Address(, , , True)
        Else
            subValCollection.Add Item:=newValue, key:=oneCell.Address(, , , True), before:=1
        End If
    Next i
    CollectionHoldsValues = True
    
    Calculate

    startWindow.Activate
    Application.Goto reference:=startPlace, Scroll:=False
    Application.EnableEvents = True
End If

Set subValCollection = Nothing
CollectionHoldsValues = False
End Sub

[mrd78]

Unbelieveable! it works like magic! Chapeau!!!

just one more request (hoping it's not to much to ask...)

the only thing i need more is to replace the "\" if it is possible perhaps with a space - handing a paper work with all these "\" will surely confuse my proffesor...

if this it doable then you just made my paper writing proccess a lot easier & faster. you can't imagine how helpful you are.

THANK YOU VERY MUCH!

[mikerickson]

In SwapValueForRange, the line[VBA]Const Indicator As String = "\" [/VBA]can be changed to meet your needs.

I'm glad it helped.

[mrd78]

hello mike.

i tried to make it work on a new work book following your direction and nada....

i opened your added file and it works partialy on sheet 1 only.
i tried to make another calculation and the function returned "#value!"
i use excel 2007- i guess it doesn't make a difference, but who knows.

i tried to do what you explained on a regular workbook and even on the PERSONAL.XLS workbook but nothing works .

i really don't understand these weird behavior.
pls help!

i send you back your file - chekout cell G18

sorry if it's too much trouble

[mrd78]

got it to work but not that easy.

only if i copy the cell from the example file you sent me to another location and then i modify it to another cell to get the furmula then it works.
what i mean is that i can't use it directly by writing the "=SUBVALS()" or from the "fx" button (func. wizard), only by copying one of your examples that works and then re-copying that as needed.

hope this helps in finding the problem.

thanks

[mikerickson]

The version you have is the one that uses Validation message locations for data storage. This version (from post #8 ) is a ton more stable.

[mrd78]

great! it works beautifully.

i have one last question/request...

the writing direction in hebrew is from right to left so i need the "=" to be on the right side of the showed fomula since the text I'm writing goes on the right side of the numbers.

hope it's not too much trouble.
(After that i'll stop bugging you....i promise)

thanks

[mikerickson]

Changing this by adding one line should do that
[VBA]Function SubVal(inputRange As Range) As String
Application.Volatile
On Error GoTo OutOfFtn

If CollectionHoldsValues Then
On Error Resume Next
SubVal = subValCollection(inputRange.Range("A1").Address(, , , True))
On Error GoTo 0
If Left(SubVal, 1) = "=" Then SubVal = Mid(SubVal, 2) & "=": Rem for Hebrew
Else
On Error Resume Next
subValCollection.Add Item:=inputRange.Range("a1"), key:=inputRange.Range("a1").Address(, , , True)
On Error GoTo 0
SubVal = "null"
End If

Exit Function
OutOfFtn:
SubVal = vbNullString
On Error GoTo 0
End Function[/VBA]

[mrd78]

no words to express my gratitude......

it works great & it's all i needed!

THANK YOU VERY MUCH !!!!!!!!!!!!!!!!!!!!!!!!!!

Albert

[mikerickson]

Glad to have helped.

[mrd78]

will it work if i copy the code into the PERSONAL.XLS ?

[mikerickson]

No.
This has two parts, a UDF called from the spreadhseet (and its dependent UDF's) and a Change routine in the ThisWorkbook code module.

Personal Macro is the wrong place for this. One could put it in an Add-In (and have the add-in set up an App. Level Calculate event?)

If that is your desire, you might want to start another thread, I'm not familiar enough with add-in's to anticipate all the issues that that process might raise. (The App. level event via add-in concerns me.)

[ramecid]

Hi Mike,
I've been trying unsuccessfully to write a code like yours (I'm an amateur VBA programmer). Luckily I found this thread and I've tried to copy the codes in VBA editor but I just get an error message. Maybe I got confused with your reply of 05-24-2008, 12:21 AM. So can you please advise me which are the final codes to be inserted to the VBA editor.
Thanks in advance and I really appreciate your extremely valuable help.

Best,

René