Search code examples
vbaexcelcell-formatting

Evaluate formula references, but keep formula structure


Is it possible in Excel to evaluate the references in a formula but keep the formula structure? e.g. if A1 = 5 and B1 = 10

=(A1+B1)/B1

would become

=(5+10)/10

in the cell, but keep the all the formula structure (i.e. = + /), rather than evaluate to 1.5.


Solution

  • I've got some almost working code you could play around with. It will work as long as individual cells are in the formula - so it won't work with A1:C1 but will with A1,B1,C1 - so no VLOOKUPS, or MATCH. Just simple formula.

    The main part of the code is credited to Bill Manville.
    There's a Stackoverflow link: Address of first layer of precedent cells via VBA in Excel and

    A couple of links to the original code:
    http://www.vbaexpress.com/forum/showthread.php?19348-Solved-Splitting-all-addresses-in-a-formula&p=142863#post142863
    http://www.ozgrid.com/forum/showthread.php?t=17028

    The code will place the formula with values in a comment in the cell:

    Public Sub ReplaceWithValues()
        ' From original code written by Bill Manville for FindPrecedents.
    
        Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
        Dim bNewArrow As Boolean
        Dim sTmpFormula As String
    
        ActiveCell.ShowPrecedents
        Set rLast = ActiveCell
        iArrowNum = 1
        iLinkNum = 1
        bNewArrow = True
    
        'Get an absolute reference version of the formula.
        sTmpFormula = Application.ConvertFormula _
                        (Formula:=ActiveCell.Formula, _
                         fromReferenceStyle:=xlA1, _
                         toReferenceStyle:=xlA1, _
                         toAbsolute:=xlAbsolute)
    
        Do
            Do
                Application.Goto rLast
                On Error Resume Next
                ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
                On Error GoTo 0
                If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
                bNewArrow = False
                If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then
                    'Formula precedent is in same workbook.
                    If rLast.Worksheet.Name = ActiveCell.Parent.Name Then
                        'Formula precedent is on the same sheet as formula.
                        sTmpFormula = Replace(sTmpFormula, Selection.Address(external:=True), Selection.Value)
                        sTmpFormula = Replace(sTmpFormula, Selection.Address, Selection.Value)
                    Else
                        'Formula precedent is in same workbook, but different sheet.
                        If InStr(Selection.Parent.Name, " ") > 0 Then
                            'If the sheet name contains a space the reference will have ' at either end.
                            sTmpFormula = Replace(sTmpFormula, "'[" & Selection.Parent.Parent.Name & "]" & _
                                Selection.Parent.Name & "'!" & Selection.Address, Selection.Value)
                        Else
                            sTmpFormula = Replace(sTmpFormula, "[" & Selection.Parent.Parent.Name & "]" & _
                                Selection.Parent.Name & "!" & Selection.Address, Selection.Value)
                        End If
                    End If
                Else
                    sTmpFormula = Replace(sTmpFormula, Selection.Address(external:=True), Evaluate(Selection.Address(external:=True)))
                End If
                iLinkNum = iLinkNum + 1  ' try another link
            Loop
            If bNewArrow Then Exit Do
            iLinkNum = 1
            bNewArrow = True
            iArrowNum = iArrowNum + 1  'try another arrow
        Loop
        rLast.Parent.ClearArrows
        Application.Goto rLast
        rLast.AddComment
        rLast.Comment.Text Text:=sTmpFormula
        Application.ScreenUpdating = True
    End Sub