PDA

View Full Version : Showing Formula with values in other language

mrd78
05-20-2008, 12:22 PM
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
05-20-2008, 06:19 PM
Welcome!

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

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

Function showValues(val1 As Range, val2 As Range) As String
showValues = "=" & val1 & "+" & val2
End Function

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 (http://www.meadinkent.co.uk/xlformtext.htm) might be pretty easily edited to suit your needs

mrd78
05-22-2008, 08:30 PM
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
05-22-2008, 11:19 PM
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

(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

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.

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
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
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
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

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

mikerickson
05-23-2008, 12:09 AM
Here's a way to use that UDF for a spreadsheet function.
Put this in a normal module
Function SUBVALS(inRange As Range) As String
Application.Volatile
On Error Resume Next

With Application.Caller.Validation
SUBVALS = .ErrorMessage
.Delete
On Error GoTo 0
.InputMessage = inRange.Range("a1").Address(, , , True)
.ShowInput = False
.ShowError = False
.ErrorMessage = SUBVALS
End With
End Function
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
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
05-23-2008, 04:52 AM
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
05-23-2008, 06:49 AM
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 moduleFunction 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
PrecedentsRRay = ArrayOfPrecedents(inRange)
If UBound(PrecedentsRRay) = 0 Then Exit Function
If PrecedentsRRay(1) Is Nothing Then Exit Function
For Each onePrecedent In PrecedentsRRay
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
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
In ThisWorkbook modulePrivate 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
End With
End If
Next oneCell
On Error GoTo 0
Calculate

Application.ScreenUpdating = True
Application.Calculation = restoreCalc
Application.EnableEvents = True
End Sub

mikerickson
05-23-2008, 09:21 PM
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
Else
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
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)

If subValCollection.Count = 0 Then
Else
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
05-24-2008, 04:08 AM
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
05-24-2008, 10:53 AM
In SwapValueForRange, the lineConst Indicator As String = "\" can be changed to meet your needs.

mrd78
05-25-2008, 12:02 AM
hello mike.

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:help .

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
05-25-2008, 01:49 AM
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
05-25-2008, 08:40 AM
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
05-25-2008, 12:24 PM
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
05-25-2008, 01:19 PM
Changing this by adding one line should do that
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
On Error GoTo 0
SubVal = "null"
End If

Exit Function
OutOfFtn:
SubVal = vbNullString
On Error GoTo 0
End Function

mrd78
05-27-2008, 07:33 AM
:bow: :bow: :bow: :bow: :bow: :bow: :bow: :clap: :clap: :clap: :clap: :clap: :thumb

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

it works great & it's all i needed!

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

Albert

mikerickson
05-27-2008, 10:07 AM

mrd78
05-27-2008, 11:37 AM
will it work if i copy the code into the PERSONAL.XLS ?

mikerickson
05-27-2008, 12:07 PM
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
10-17-2013, 10:18 PM
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.

Best,

René

SamT
10-21-2013, 07:00 AM
Ramecid,

Welcome to VBA Express, I hope we can fulfill all your requests.

Please note that all post times are shown in your local time zone, so I can only guess that you mean Mike's post #8. See top right of each post for Post #.

I haven't analyzed the code, but I think you want to use the code from Post # 7.

If that doesn't work, let us know what error you get and what line it is on.

You can find the exact line the error occurs on by placing the cursor in sub "Workbook_SheetCalculate" and pressing F8 until you get the Error.

mikerickson
10-21-2013, 11:34 AM
If nessesary, I'll do my best to try to re-remember what I was doing.

Glissege
08-27-2015, 06:31 AM
I tried to copy the two files from post #8 but i get an error message.

In post #5 it said:

"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)"

What did i do wrong? I'm using Excel 2010 and i really wish i could add this in my Excel files.

SamT
08-27-2015, 11:28 AM
f that doesn't work, let us know what error you get and what line it is on.

You can find the exact line the error occurs on by placing the cursor in sub "Workbook_SheetCalculate" and pressing F8 until you get the Error.

Glissege
08-28-2015, 12:47 AM
f that doesn't work, let us know what error you get and what line it is on.

You can find the exact line the error occurs on by placing the cursor in sub "Workbook_SheetCalculate" and pressing F8 until you get the Error.

I added the first tekst in a module, the second tekst i added in the workbook.
Cell A1 = B1 + C1
With B1 = 2 & C1 = 3

What do i need to write in the excel file?
I tried =SUBVALS(A1) and i get a "#Value" error

mikerickson
08-28-2015, 06:52 AM
To use this as a worksheet formula, one needs to include the code from both post 4 and 5.

Look at Sheet1! column E in the attached.

Glissege
08-31-2015, 05:11 AM
Is it a problem if my Excel is in Dutch? I use windows 7; Excel in dutch. When i open the file i see the values. When i sav eit on my desktop i get an error =Naam# (=Name#)

mikerickson
08-31-2015, 07:01 AM
I'd need to check through the code. The only thing that I can think of is that the UDF parses formulas. What is your divider?
Do you use =MAX(3 , 4) or =MAX(3 ; 4) ?

Glissege
08-31-2015, 10:59 AM
I'd need to check through the code. The only thing that I can think of is that the UDF parses formulas. What is your divider?
Do you use =MAX(3 , 4) or =MAX(3 ; 4) ?

We use = MAX(3;4)

snb
09-01-2015, 12:49 AM
@Glissege

Plaats je vraag in Helpmij.nl

mikerickson
09-01-2015, 07:46 AM
We use = MAX(3;4)

I'll need to look through the code later, when I wrote it, I assumed American conventions.

Glissege
09-03-2015, 05:41 AM
I'll need to look through the code later, when I wrote it, I assumed American conventions.

If i set my language and settings to US it will work. Unfortuanly the people i sent this document too only have the dutch excel.

I have a second question, when i input some numbers and press enter, the selection goes straight to the subval. What is the reason for this and can we change it?

mikerickson
09-03-2015, 07:43 AM
If i set my language and settings to US it will work. Unfortuanly the people i sent this document too only have the dutch excel.

I have a second question, when i input some numbers and press enter, the selection goes straight to the subval. What is the reason for this and can we change it?
As written, the code uses .NavigateArrows and ActiveCell to determine the precedents of a cell. Since then, I've learned that the ActiveCell is not needed, so that could be re-written and (hopefuly) the second issue will be addressed.

mikerickson
09-03-2015, 05:24 PM
The core of the UDF is the function ValuesInsteadOfPrecenents, which, to my testing, works fine. However, it uses methods that are not available to UDFs that are called by a worksheet formula. i.e. running this code will get the expected result

Sub test()
End Sub

But putting =ValuesInsteadOfPrecedents(C1) in a cell will get #VALUE.

SUBVALS was a workaround for this that involves the Calculate event and Validation.

Since it was first written, Validation has changed. It used to be that one could access the .InputMessage and .ErrorMessage of any cell's .Validation object, even if there was no validation set. That is no longer the case.

Glissege
09-09-2015, 02:23 AM
Currently i use the english language and then change the english words to the dutch words. Do you have an idea how i can change it so it works on toher langagues too in europe?

Thanks for your time and effort!

GoChucky
01-22-2016, 05:53 AM
Sorry for bumping an old topic like this.
I'm having trouble using this.
I got the same problem as Glissege. I tried using it on an English version of Excel and it works fine, but I need it on multiple dutch excel versions..

I looked into the code a bit and I found that deleting the following code and executing the whole code using F8 works, but once I change any cell those functions will become blank again.

If Me.Cells.SpecialCells(xlCellTypeAllValidation) Is Nothing Then Exit Sub

Does someone have any idea?
I would really appreciate any help!

SAM2
02-05-2017, 04:51 PM
Hi could somebody help on this. I have followed the procedure mentioned under #7 but it has not worked. I wonder whether somebody could look at and comment on the attached file. Thanks