Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

UDF - show formula with values?

Status
Not open for further replies.

justhumm

Structural
May 2, 2003
111
0
0
US
I haven't looked into this too much, yet, but figured I would ask...

Is anyone aware of a User-Defined Function (UDF) or some way that's been developed to write out the formula (in value form) that's been entered in another cell?

Thanks!

Capture_i3ntbj.jpg
 
Replies continue below

Recommended for you

But both the FormulaText function and the .Formula method will return the formula as cell addresses, not the values in those cells.

The link below has a link to my Eval2 spreadsheet which has an Eval function, which will evaluate a formula entered as text, based upon a list of symbols and their associated values. It also has an option to return the formula as a text string with the symbols converted to values, and a substitute() UDF that will do the same thing.


That's not exactly what was asked for, but it may serve your purpose as well (or better).

I'll also have a look to see if I have a UDF that will do exactly what was requested.

Doug Jenkins
Interactive Design Services
 
The routine below will convert cell addresses in the current active cell into values, and paste the results in the next cell to the right:
Edit 1: The original version only worked if the precedent cells were in a contiguous range. The version below will work for non-contiguous cells, but it will give incorrect results if one cell in the formula contains the address of another cell, for instance if the formula contains B1 and B11. It will take a bit more work to fix that. I'll post an updated version in a new message later.

Edit 2: See next message for a link to the updated version that should handle any cell addresses correctly.

Code:
 Sub Addr2Val()
Dim PrecCells As Variant, CellRng As Range, NumP As Long, i As Long, Form As String
Dim CellAddr As String, CellVal As Variant, xCell As Range

    Set CellRng = Application.ActiveCell
    Form = CellRng.Formula
    Form = Replace(Form, "$", "")
    Set PrecCells = CellRng.Precedents
    For Each xCell In PrecCells
        CellAddr = xCell.Address
        CellAddr = Replace(CellAddr, "$", "")
        CellVal = xCell.Value
        Form = Replace(Form, CellAddr, CellVal)
    Next
    CellRng.Offset(0, 1).Value = " " & Form
    Set CellRng = Nothing
    Set PrecCells = Nothing
End Sub

It would be good if that could be done as a UDF, which would update automatically, and could be placed anywhere, but it doesn't work as a UDF for some reason. In a UDF the .DirectPrecedents method returns the address of the cell, rather than it's precedents. This seems to be a VBA "feature".

Notes:
1. Very limited testing
2. It will write over whatever is in the adjacent cell without warning.
3. It would be quite easy to modify to work on a selected range, rather than a single cell, and to allow output to a selected range, rather than the adjacent cell.


Doug Jenkins
Interactive Design Services
 
I have now updated the Addr2Val macro so that it works correctly if any cell addresses in the formula are included in other addresses. Also if you want the output in a column other than the next right you can select a range to the right, and the results will go in the right hand column of the selected range:

Addr2Val1-1_yj9ezc.png


The new macro calls the Eval UDF. If you want to use this routine in another file the easiest ways are to drag and drop both VBA code modules into the new file, or have both files open, then you can run Addr2Val with a range or cell selected in the other file.

Download the new Eval2 spreadsheet from:

Eval2.zip

Doug Jenkins
Interactive Design Services
 
Thanks for all of the responses.

I feel kinda' stupid, but I actually never realized FORMULATEXT() was available.

And it's a bummer that Microsoft doesn't allow the use of precedent statements in UDF's.

I was just playing with a very basic UDF-workaround. And it almost seems to be working. I am getting the values I would expect when debugging in the immediate window, but am getting a #VALUE! error in the actual cell. Any thoughts on what I'm doing wrong?

Capture_dhkvdp.jpg


Capture02_ufctyf.jpg


Code:
Function AddrToVal(CellRng As Range) As String
    Dim i As Integer, j As Integer, k As Integer
    Dim xChar1 As Integer, Char2 As Integer
    Dim Form As String
    Dim CellAddr As String

    Form = CellRng.Formula 
Debug.Print Form
    Form = Replace(Form, "$", "")
    Form = Replace(Form, "=", "'")   
Debug.Print Form
    
    For i = 1 To Len(Form)
        xChar1 = Asc(Mid(Form, i, 1))
        xChar2 = Asc(Mid(Form, i + 1, 1))
        If (xChar1 >= 65) _
        And (xChar2 > 47 And xChar2 <= 58) Then
                CellAddr = Chr(xChar1) & Chr(xChar2)
                Form = Replace(Form, CellAddr, Range(CellAddr).Value)
Debug.Print Form
                i = 1
        End If
    Next i  

Debug.Print Form
    AddrToVal = Form
    
End Function
 
Yup...I was being stupid and crashing myself out of the loop on the last go-around.

This is basically what I was thinking, but this version only works for cell references with single-letter column names and row names up to 3-digits (A1, B20, C300, etc. - NOT AB4123, yet). And I'll have to see about playing with the number formats when I'm feeling more ambitious.

Capture_bj9lmm.jpg


Code:
Function AddrToVal(CellRng As Range) As String
    Dim i As Integer, j As Integer, k As Integer
    Dim xChar1 As Integer, xChar2 As Integer
    Dim xChar3 As Integer, xChar4 As Integer, xChar5 As Integer
    Dim Form As String
    Dim CellAddr As String

    Form = CellRng.Formula
    Form = Replace(Form, "$", "")
    'Form = Replace(Form, "=", "'")

    xChar1 = 0: xChar2 = 0: xChar3 = 0: xChar4 = 0: xChar5 = 0

    For i = 1 To Len(Form)
        If i < Len(Form) Then   'IF01==========
            xChar1 = Asc(Mid(Form, i, 1))
            xChar2 = Asc(Mid(Form, i + 1, 1)): On Error Resume Next
            xChar3 = Asc(Mid(Form, i + 2, 1)): On Error Resume Next
            xChar4 = Asc(Mid(Form, i + 3, 1)): On Error Resume Next
            xChar5 = Asc(Mid(Form, i + 4, 1)): On Error Resume Next
   
            If xChar1 < 65 Or xChar1 > 90 Then  'IF02==========
                GoTo GoToHere01
            ElseIf 3 = 3 Then
                If xChar2 >= 48 And xChar2 <= 57 _
                And xChar3 >= 48 And xChar3 <= 57 _
                And xChar4 >= 48 And xChar4 <= 57 Then
                    CellAddr = Chr(xChar1) & Chr(xChar2) & Chr(xChar3) & Chr(xChar4)
                    Form = Replace(Form, CellAddr, Range(CellAddr).Value)
                    i = 1
                ElseIf 2 = 2 Then
                    If xChar2 >= 48 And xChar2 <= 57 _
                    And xChar3 >= 48 And xChar3 <= 57 Then
                        CellAddr = Chr(xChar1) & Chr(xChar2) & Chr(xChar3)
                        Form = Replace(Form, CellAddr, Range(CellAddr).Value)
                        i = 1
                    ElseIf xChar2 >= 48 And xChar2 <= 57 Then
                           CellAddr = Chr(xChar1) & Chr(xChar2)
                           Form = Replace(Form, CellAddr, Range(CellAddr).Value)
                           i = 1
                    End If
                End If
            End If  'IF02==========
        End If 'IF01==========
GoToHere01:
    Next i

AddrToVal = Form
End Function
 
I revised the "replace" lines, so that it seems to be maintaining the number formatting of any referenced cells:

Code:
Form = Replace(Form, CellAddr, Range(CellAddr).Text)
 
...and I just realized that I needed to move the "xChar" to reset for each loop...

Code:
[COLOR=#4E9A06]' xChar1 = 0: xChar2 = 0: xChar3 = 0: xChar4 = 0: xChar5 = 0[/color]

For i = 1 To Len(Form)
xChar1 = 0: xChar2 = 0: xChar3 = 0: xChar4 = 0: xChar5 = 0
 
So far, it seems to be functioning like I want it to, for now (only works for single column names - "D", NOT "DA", etc. - and rows between 1-999).

However there's something weird going on when working with TRIGONOMETRY functions (sin, cos, radians, etc.). The UDF is working, until it gets to the last cell reference and it seems to be jumping out of the loop and just displays the last cell address in the function. (will post picture)

Does anyone know if there's some property/behavior of Excel's native trig functions that would be causing this?

Thanks!

Capture_m3i5um.jpg
 
Reviewing the Eval function in the spreadsheet I linked previously, it has the option to return the input function with listed parameters replaced by their value, so this can be quite easily updated to work with cell addresses as well. I have updated the Eval function to do that, and also added an Addr2Val_F function that does the same thing, but only requires the text formula as input. The full code is available in the attached file, but the basic process is:

Extract characters from the input string from left to right:
If the character is not a number or letter or _ then add it to the output string
If it is, add it to the sub-string to be converted to a value
Continue until the next character that cannot be part of an address or range name
Check if the sub-string is a valid cell address or range name
if it is not, add the sub-string to the output string
if it is, add the cell value to the output string
Continue to the end of the input string

This will work with any cell addresses or valid range names. It also works with cell addresses that incorporate other addresses (e.g. B21 and B2).

The Eval version also optionally allows listed parameters to be converted to assigned values. Addr2Val_F only works with cell addresses and range names. Note that if the eval function is copied to another spreadsheet the scripting dictionary must be enabled using the Tools-References menu in the VB Editor.

The screenshot below shows some typical output, and the file is attached for download

Addr2Val_F_gxo1hz.png



Doug Jenkins
Interactive Design Services
 
This code handles any reference.

My formula:
[tt]
=A1*A2^3/(3*ACT1*ACT2)
[/tt]
...and my result:
[tt]
=100*10^3/(3*20000000*0.0833333)
[/tt]

My code:
Code:
Function AddrToVal2(rCell As Range) As String
'SkipVought 2017 AUG 29
    Dim i As Integer, p1 As Integer, p2 As Integer
    Dim Form As String, eval As String, r As Range
    
    Form = rCell.Formula
    Form = Replace(Form, "$", "")
    AddrToVal2 = "="
    
    p1 = 2
    For i = 2 To Len(Form)
        Select Case Mid(Form, i, 1)
            Case "(", ")", ",", "+", "-", "*", "/", ":", "&", "^"
                p2 = i - 1
                eval = Mid(Form, p1, p2 - p1 + 1)
                On Error Resume Next
                Set r = Range(eval)
                If Err.Number = 0 Then
                    AddrToVal2 = AddrToVal2 & Range(eval).Value & Mid(Form, i, 1)
                Else
                    AddrToVal2 = AddrToVal2 & eval & Mid(Form, i, 1)
                    Err.Clear
                End If
                On Error GoTo 0
                p1 = i + 1
        End Select
    Next
End Function

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
@SkipVought

I haven't had much time to look into this, but I'm just noticing now that your code seems to have the same sort of behavior...jumping out of the loop at the end of some equations, but yours seems to be producing blanks...

In cell AC13, in the image below, the formula in the referenced cell is:
"=A6+A7+A8+A9+A10" (5 values)

But the AddrToVal2 is only producting:
"=1+2+3+4+" (4 value)

Any thoughts on why this sort of behavior is occurring?

Thanks!

Capturexx_fnwebr.jpg
 
Thanks. Needed to add a post evaluate...
Code:
Function AddrToVal2(rCell As Range) As String
'SkipVought 2017 AUG 29
'SkipVought 2017 OCT 31 - Added Evaluate subroutine & 2 GoSub Evaluate
    Dim i As Integer, p1 As Integer, p2 As Integer
    Dim Form As String, eval As String, r As Range
    
    Form = rCell.Formula
    Form = Replace(Form, "$", "")
    AddrToVal2 = "="
    
    p1 = 2
    For i = 2 To Len(Form)
        Select Case Mid(Form, i, 1)
            Case "(", ")", ",", "+", "-", "*", "/", ":", "&", "^"
                GoSub Evaluate
        End Select
    Next
    GoSub Evaluate
    Exit Function
    
Evaluate:
    p2 = i - 1
    eval = Mid(Form, p1, p2 - p1 + 1)
    On Error Resume Next
    Set r = Range(eval)
    If Err.Number = 0 Then
        AddrToVal2 = AddrToVal2 & Range(eval).Value & Mid(Form, i, 1)
    Else
        AddrToVal2 = AddrToVal2 & eval & Mid(Form, i, 1)
        Err.Clear
    End If
    On Error GoTo 0
    p1 = i + 1
    Return
End Function

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
@SkipVought

I'm a VBA novice and not familiar with SELECT...CASE and GoSub (if it's any different from GoTo) statements.

Looking at the older and newer code side-by-side, I can't wrap my head around what the functional difference is.

Just for my own knowledge, can you give a quick description of what you changed? (functionally speaking)

Thanks a lot!

AddrToVal2_q3m5gr.jpg
 
This was a process that executed each time an non-reference character was encountered in the expression, as the procedure looped thru the characters of the expression.

Well that process also must occur after the last reference in the experssion is encountered, which at that point, is after the loop finishes.

As a programmer, seeing that I must use the same process inside the loop and outside the loop, I chose to make a subroutine that I can call from inside the loop and outside the loop, rather than recording the same code Multiple times.

The difference between a GoSub and a GoTo (Yuk, Plz do not jump around with GoTos!!!) is that a GoSub Returns to the next instruction following the call, whereas the GoTo (Yuk!!!) is like a people, wandering in the wilderness: aimless and unstructured in nature.

The subroutine has this form...
Code:
‘ some code here
   GoSub [i]SubroutineName[/i]
‘ more code
   GoSub [i]SubroutineName[/i]
‘Even more code
‘...any subroutine may be called 1 or more times and there can be multiple subroutines
‘ Exit [i]ProcedureType[/i]

‘This is where any subroutine(s) go, AFTER the Exit for the procedure.
[i]SubroutineName[/i]
‘Code for this subroutine
Return

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Status
Not open for further replies.
Back
Top