PDA

View Full Version : Macro to replace part of a formula with result



kkrastev
08-19-2016, 02:55 PM
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
08-19-2016, 09:12 PM
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
08-19-2016, 10:56 PM
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
08-20-2016, 05:59 PM
I understand ""what you are referring to, but you haven't explained "why".

mikerickson
08-20-2016, 08:31 PM
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
08-20-2016, 11:39 PM
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
08-21-2016, 06:06 AM
Why not just Copy+PasteSpecialValues and then format in thousands or millions?

Seems like a more 'usual' way of doing it

kkrastev
08-22-2016, 01:25 AM
Thanks Paul.

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

kkrastev
08-22-2016, 02:11 AM
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
08-22-2016, 07:11 AM
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
08-22-2016, 08:09 AM
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
08-22-2016, 08:11 AM
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
08-22-2016, 08:19 AM
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

1691916920

mikerickson
08-22-2016, 08:33 AM
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
08-22-2016, 09:43 AM
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

16921






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