Show Equation of Referenced Cell

[MrRhodes2004]

I am in well over my head:
I am sure this will be a very difficult task!
Does any already have or know how to create function that will create a string based upon the referenced cell and the formatting of the referenced cells. See the attached for an example.

Cells D10, E10, and F10 are inputs with specific cell formatting.
Cell G10 references the inputs.
Cell H10 references G10 and shows the equation based on the cell formula and the cell formatting of the inputs.




Function ShowEQ(rEq As Range, Optional iDecimals As Integer, Optional bFormat As Boolean) As String

'- look for specific items in rEQ
'Const crep As String = "(([A-Za-z0-9_]+|'[^']+')!)?\$?[A-Z]{1,2}\$?[0-9]+"
'Const mrep As String = "(([A-Za-z0-9_]+:[A-Za-z0-9_]+|'[^']+:[^']+')\!)|(\$?[A-Z]{1,2}\$?[0-9]+:\$?[A-Z]{1,2}\$?[0-9]+)"

'determine formats of referenced cells


End Function

[khu]

I hope I understand what you're looking for, but this will let you select a cell and then run the program and it will generate a picture of the formula that is in the cell. It dumps into word then imports it back into excel as an image. It's nice in as an image because of word's formatting, but you could change how it is reintroduced.

Sub ExpandEqn()

Dim dummy As String
Dim appWd As Word.Application
Dim docWd As Word.Document
Dim objRange As Word.Range
Dim objEq As OMath

Set FindActiveCell = Application.ActiveCell
GetRange = CStr(FindActiveCell.Address())
dummy = Range(GetRange).Formula
ActiveCell.Offset(1, 0).Activate
NextActiveCell = CStr(FindActiveCell.Address())

'Word
Set appWd = CreateObject("Word.Application")
appWd.Visible = False
Set docWd = appWd.Documents.Add
Set objRange = docWd.Application.Selection.Range
objRange.Text = dummy
docWd.Application.Selection.OMaths.Add objRange
docWd.Application.Selection.OMaths.BuildUp
docWd.Application.Selection.WholeStory
docWd.Application.Selection.Copy
'Back to Excel
Range(NextActiveCell).Select
ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False
'Clear Word
appWd.Quit (False)
Set docWd = Nothing
Set appWd = Nothing

[MrRhodes2004]

Thank Khu but idea is that the function would be active and would change as the information in the referenced cell changes. In a set of calculations, there are typically hundreds of equations that are are interrelated. Using the Word equation creator is a slick idea though. But it would have to open Word hundreds of times to keep up with all of the equations.
Typically, in the past we have created these equation with something like:
=" = ("&FIXED(D10,2)&"in/12) * "&FIXED(E10,3)&"ft * "&FIXED(F10,1)&"ft"
I am looking for a function that will basically do the above but programmatically.

[Paul_Hossler]

Maybe


Option Explicit
Function CheckInputs(H As Range, W As Range, L As Range) As String

CheckInputs = "=(" & H.Text & "/12) * " & W.Text & " * " & L.Text
End Function



Used like

=CheckInputs($D$10,$E$10,$F$10)

to display

=(10.35in/12) * 10.363ft * 4.3ft

Paul

[MrRhodes2004]

Thank you Paul, that appears to be the similar as
=" = ("&FIXED(D10,2)&"in/12) * "&FIXED(E10,3)&"ft * "&FIXED(F10,1)&"ft"
but just in code format. The function needs to determine what the formula as it will be different in every use.

Though, maybe having the code look for the range in the formula, I might be able to do what you did with range.text.

The formula of each referenced cell will be different.

The function or sub needs to be completely autonomous instead of the "Hand Developed Equation" as shown in cell H10 of the attached workbook.

It almost needs to read in the referenced formula, fill in the range data and range formatting and spit it back out. I don't know...

Just brain storming...

[Paul_Hossler]

ahhh - I didn't realize that you were looking for a general purpose formula generator.

Lots of issues / pitfalls / complications I believe: absolute references, named ranges, etc.


Option Explicit
Function ShowFormula(r As Range) As String
Dim s As String

s = r.Cells(1, 1).Formula

1. Determine what pieces are references
'=(D10/12)*E10*F10

'

'2. Get the .Text for each reference
' 10.35in 10.36ft 4.3ft

'3. rebuild the formula (1) with the pieces (2)
' =(10.35in/12)*10.36ft*4.3ft

ShowFormula = "=" & "(" & "10.35in" & "/12)*" & "10.36ft" & "*" & "4.3ft"

End Function


I'm (fairly) sure it's doable, but it seems like a lot fiddly programming.

Paul

[MrRhodes2004]

Paul,

Yes, there are many complications the code. If at first we could figure out how to do the basics then we could move on to more advanced versions of it. In some places it just won't work well like with sum(A1:D4)... how do you show that? You don't. Maybe with something like that we just show the result of the sum.

I have been trying to modify code that I was given a while ago. It works to some extents but it is very limited:
Option Explicit
Function SF(r As Range, Z As Integer) As String
'Previously called gfrv()
'Posted origionally by Harlan Grove(HrlnGrv@aol.com) on microsoft.public.excel.questions 2002-02-27
'Modified , 09/22/05 : now user does not need to refresh equation for function to work
'Modified , 09/22/05 : now has ability to specify number of decimal places to display.

Const crep As String = "(([A-Za-z0-9_]+|'[^']+')!)?\$?[A-Z]{1,2}\$?[0-9]+"
Const mrep As String = "(([A-Za-z0-9_]+:[A-Za-z0-9_]+|'[^']+:[^']+')\!)|(\$?[A-Z]{1,2}\$?[0-9]+:\$?[A-Z]{1,2}\$?[0-9]+)"

Dim v As Variant, n As Long
Dim regex As Object, matches As Object, m As Object

SF = Mid(r.Formula, 2)

Set regex = CreateObject("vbscript.regexp")
regex.Global = True

regex.Pattern = mrep
Set matches = regex.Execute(SF)
If matches.Count > 0 Then Exit Function

regex.Pattern = crep
Set matches = regex.Execute(SF)
n = matches.Count - 1

For n = n To 0 Step -1
Set m = matches.Item(n)
v = Evaluate(m.Value)
If IsNumeric(Val(v)) = True Then
v = Application.WorksheetFunction.Round(v, Z)
End If
SF = Left(SF, m.FirstIndex) & CStr(v) & _
Mid(SF, m.FirstIndex + m.Length + 1)

Next n
End Function

[SamT]

Sub test()
'determine formats of referenced cells
Type Cel4mat
CelAddy As String 'Cel Adress as Array item ID
Num4mat As String 'NumberFormat
FBold As Boolean 'Boldness
'etc
End Type

Dim FMat(Selection.Count) As Cel4mat
Dim Cel As Range

With Cel
FMat(i).CelAddy = .Address
FMat(i).Num4mat = .NumberFormat
FMat(i).FBold = .Bold
'Etc
End With
End Sub