Macro to replace part of a formula with result

[kkrastev]

Hello,

I am referring to the thread below:

vbaexpress.com/forum/archive/index.php/t-41469.html

I am trying to achieve the same but my formula is much more siplistic --> [Cell Ref]/1000

Could you please help by suggesting a macro that would show the result of [Cell Ref]/1000?

For example:
- Previously: =A1/1000
- Now: =5000/1000

Where the value of A1 is 5000

I.e. as if I have selected the cell reference and clicked F9.

Many thanks in advance,

KK

[Aussiebear]

I still don't follow the logic that your chasing here. Excel makes it extremely easy to follow your example where the cell shows the result and the formula bar shows the "=A1/1000". If you are worried about complex formulas not being calculated correctly add a helper column in.

[kkrastev]

Thanks Aussuebear.
Did you take a look at the thread I was referring to?

Say, in column A (starting from A1) I have a number of hard-coded numbers: 3, 5, 7, etc.
In column B (starting from B1) I have incorporated the formula =A1/1000, A2/1000, A3/1000

Typically, if you select cell B1 and if you enter content editing and mark the A1 piece and press F9, you will get 3/1000, instead of =A1/1000. In other words, instead of the cell reference you will get the calculation.

Now imagine i have N such formulas in column B. I would need the macro to replace the reference in the formula, with the actual number but keep the formula intact, i.e. keep the "/1000" part.

Hope this clarifies.

Thanks.

[Aussiebear]

I understand ""what you are referring to, but you haven't explained "why".

[mikerickson]

Possibly this will work for you.
Given a cell that contains a formula, ConstantReplace will return the formula in that cell with the cell references replaced by their values.
Those replaced values are surrounded by square brackets to distinguish from constants in the formula.
The example in the OP would return [5000]/1000

Note that the formula can only refer to open workbooks. It doesn't work for closed workbooks.
Note also that, multi-cell references, like SUM(A1:B2) are not changed. (Would one want to return only the two values in A1 and B2 or all four values or ....)
Also, the leading = has been removed from the formula so that the string can be placed in a cell without being interpreted as a formula
Finally, ConstantReplace cannot be used as a UDF.

Note the testing sub at the bottom of the code.

(I join with Aussiebear in wondering "why?")

Function ConstantReplace(CellWithFormula As Range) As String
    Dim i As Long, j As Long, pointer As Long
    Dim strFormula As String, strReplacement As Variant
    Dim colPrecedents As New Collection
    Dim onePrecedent As Range, oneAddress As String
    Dim allPrecedents() As String
    ReDim allPrecedents(1 To 1)
    
    With CellWithFormula.Cells(1, 1)
        strFormula = .Formula
        strFormula = Application.ConvertFormula(strFormula, xlA1, xlA1, xlAbsolute)
        
        .Parent.ClearArrows
        .ShowPrecedents
        
        Rem build array of all precedent references
        i = 1
        Do
            On Error Resume Next
            Set onePrecedent = .NavigateArrow(True, 1, i)
            colPrecedents.Add Item:=onePrecedent, Key:=onePrecedent.Address
        Loop Until Err
        
        i = 1
        Do
            Set onePrecedent = .NavigateArrow(True, i, 1)
            On Error Resume Next
            colPrecedents.Add Item:=onePrecedent, Key:=onePrecedent.Address
            Err.Clear
            i = i + 1
        Loop Until onePrecedent.Address(, , , True) = .Address(, , , True)
        
        For Each onePrecedent In colPrecedents
            If onePrecedent.Address(, , , True) <> .Address(, , , True) Then
                ' add "[Workbook1.xlsm]Sheet1!$A$1" to array
                oneAddress = onePrecedent.Address(, , , True)
                GoSub AddOneAddressToArray
                If onePrecedent.Parent.Parent.Name = .Parent.Parent.Name Then
                    ' if oneprecident is in my workbook add "Sheet1!$A$1" to array
                    oneAddress = Replace(onePrecedent.Address(, , , True), "[" & onePrecedent.Parent.Parent.Name & "]", vbNullString)
                    GoSub AddOneAddressToArray
                    If onePrecedent.Parent.Name = .Parent.Name Then
                        'if onePresident is on same sheet then add "$A$1" to array
                        oneAddress = onePrecedent.Address
                        GoSub AddOneAddressToArray
                    End If
                End If
            End If
      Next onePrecedent
        
    End With
    If 0 < pointer Then
        ReDim Preserve allPrecedents(1 To pointer)
        
        Rem sort allprecedents on length of address
        For i = 1 To pointer - 1
            For j = i + 1 To pointer
                If Len(allPrecedents(i)) < Len(allPrecedents(j)) Then
                    oneAddress = allPrecedents(i)
                    allPrecedents(i) = allPrecedents(j)
                    allPrecedents(j) = oneAddress
                End If
            Next j
        Next i
        
        Rem replace references with values
        For i = 1 To pointer
            strReplacement = Chr(5)
            If Range(allPrecedents(i)).Count = 1 Then
                strReplacement = Evaluate(allPrecedents(i))
                If strReplacement = vbNullString Then
                    strReplacement = """"""
                Else
                    Select Case TypeName(strReplacement)
                        Case "String"
                            strReplacement = Chr(34) & strReplacement & Chr(34)
                        Case "Boolean"
                            strReplacement = UCase(CStr(strReplacement))
                        Case "Double"
                            strReplacement = CStr(strReplacement)
                    End Select
                End If
                strReplacement = "[" & strReplacement & "]"
            End If
            If strReplacement <> Chr(5) Then
            strFormula = Replace(strFormula, allPrecedents(i), strReplacement)
            End If
        Next i
        
        If strFormula Like "=*" Then strFormula = Mid(strFormula, 2)
        ConstantReplace = strFormula
    Else
        ConstantReplace = CellWithFormula.Cells(1, 1).Text
    End If
    Set colPrecedents = Nothing
    CellWithFormula.Parent.ClearArrows
    Exit Function
AddOneAddressToArray:
    pointer = pointer + 1
    If UBound(allPrecedents) < pointer Then ReDim Preserve allPrecedents(1 To 2 * pointer)
    allPrecedents(pointer) = oneAddress
    Return
End Function

Sub test()
    Dim oneCell As Range
    For Each oneCell In Sheet1.Cells.SpecialCells(xlCellTypeFormulas)
        oneCell.Offset(10, 0) = ConstantReplace(oneCell)
    Next oneCell
End Sub

[kkrastev]

Thanks both.

I have a multi-sheet financial model with hard-coded historical financials.

I need to include functionality of figures to be presented in thousands, millions or as are.

Given the large amount of cells (more than 20,000), without the macro, this would mean going manually in each cell and inserting the division.

With the macro I can create references to the hard-coded numbers (effectively creating shadow P&L statements) and then use the macro to remove the references.

Hope this clarifies.

Many thanks - will test and let you know if it works.

Regards,
KK

[Paul_Hossler]

Why not just Copy+PasteSpecialValues and then format in thousands or millions?

Seems like a more 'usual' way of doing it

[kkrastev]

Thanks Paul.

Because I need to have the functionality - say, through a drop down.

[kkrastev]

Mike,

Apologies in advance if my questions look stupid but I am not familiar with VBA in general and find it difficult to modify the code to edit the functionality.

1) Do you think there is any easy way to make the macro work only for cells that are selected?
2) Do you think it is possible to have =Constant/Divider, i.e. have the = sign so that Excel reads it as a formula and also remove the brackets?

Happy to clarify further if needed.

Many thanks for your help!

[Paul_Hossler]

Because I need to have the functionality - say, through a drop down.

For example:
- Previously: =A1/1000
- Now: =5000/1000

Where the value of A1 is 5000

I'm not seeing the reason to replace (say)

B1=A1/1000

with

B1=5000/1000

Once it's replaced, then it's gone and you can't run the macro again, dropdown or not


So I join the others is asking "Why?"

What are you REALLY trying to do?

It sort of looks like you want to freeze values (maybe) and display numbers in 1,000's (maybe)

[kkrastev]

Again - i want to insert functionality for numbers to be presented in thousands, millions or as are.

If you thousands of cells of hard-coded values, then the only viable way to insert that functionality (without a macro) is to go into each cell and insert division. For that matter it need not be "/1000" but rather a division by a named cell that can be 1,1000 or 1000000.

"
B1=5000/1000

Once it's replaced, then it's gone and you can't run the macro again, dropdown or not
"

/1000 was just an example. i will then find replace "/1000" with a named cell which will insert the functionality.

[mikerickson]

2) Do you think it is possible to have =Constant/Divider, i.e. have the = sign so that Excel reads it as a formula and also remove the brackets?

Yes, just remove these two lines

' ...
strReplacement = "[" & strReplacement & "]"
' ...
If strFormula Like "=*" Then strFormula = Mid(strFormula, 2)
'...

1) Do you think there is any easy way to make the macro work only for cells that are selected?

Yes

Sub test()
    Dim oneCell As Range
    Dim memSelection As Range
    Set memSelection = Selection
    
    For Each oneCell In Selection
        If oneCell.HasFormula Then
            MsgBox oneCell.Address & vbCr & ConstantReplace(oneCell)
        End If
    Next oneCell
    
    Application.Goto memSelection
End Sub

You should note that running ConstantReplace will change Selection, because it uses the NavigateArrow method.
If the CellWithFormula argument is off of the ActiveSheet, the ActiveSheet will change.
Therefore, to restore Selection to what it was before using ConstantReplace, one should use Application.Goto rather then Select.

Its not clear what you want to do with this modified formula string.
The OP said that you want to convert a formula to its intermediate evaluation "=A1/1000" to "=5000/1000"
It didn't say what you want to do with the "=5000/1000" once you have it.

[Paul_Hossler]

Again - i want to insert functionality for numbers to be presented in thousands, millions or as are.

Again -- you can use Custom Number Formatting to handle presenting in thousands, millions or as are

Without a macro, and full precision is retained internally

Capture.JPGCapture1.JPG

[mikerickson]

Paul's number formatting could easily be incorporated into the UDF.

But we are still waiting for an answer to "what do you want to do with the string that the UDF returns" and "why do you want to do that. What is the purpose of all of this?"

[Paul_Hossler]

I have a macro that applies various .NumberFormat depending on the size of the number

This is a money-oriented version

The sub runs on a selected group of cell or a whole column so you don't need to mess with individual cells and there is no UDF that returns a formatted string that cannot easily be used in calculations

Capture.JPG

Option Explicit

Sub VariableFormat()
    Dim r As Range, c As Range, r1 As Range, r2 As Range
    Set r = Intersect(Selection, ActiveSheet.UsedRange)
    
    Set r1 = Nothing
    Set r2 = Nothing
    
    On Error Resume Next
    Set r1 = r.SpecialCells(xlCellTypeConstants, xlNumbers)
    Set r2 = r.SpecialCells(xlCellTypeFormulas, xlNumbers)
    On Error GoTo 0
    
    If Not r1 Is Nothing Then
                
        r1.NumberFormatLocal = Application.International(xlGeneralFormatName)
        
        For Each c In r1.Cells
            Select Case Abs(c.Value)
                Case Is < 10 ^ 3
                    c.NumberFormatLocal = "$#,##0"
                Case Is < 10 ^ 6
                    c.NumberFormatLocal = "$#,##0,.0""K"""
                Case Is < 10 ^ 9
                    c.NumberFormatLocal = "$#,##0,,.0""M"""
                Case Else
                    c.NumberFormatLocal = "$#,##0,,,.0""B"""
            End Select
        Next
    End If
    
    If Not r2 Is Nothing Then
        
        r2.NumberFormatLocal = Application.International(xlGeneralFormatName)
        
        For Each c In r2.Cells
            Select Case Abs(c.Value)
                Case Is < 10 ^ 3
                    c.NumberFormatLocal = "$#,##0"
                Case Is < 10 ^ 6
                    c.NumberFormatLocal = "$#,##0,.0""K"""
                Case Is < 10 ^ 9
                    c.NumberFormatLocal = "$#,##0,,.0""M"""
                Case Else
                    c.NumberFormatLocal = "$#,##0,,,.0""B"""
            End Select
        Next
    End If
    
End Sub