VBA to Replace the End of a Formula

[mahon]

I've been piecing together the below macro to insert a round function across a range of cells (Excel 2007). It just asks how many places to round to and drops in the formula on any cells with a value or formula. I am trying to add a level that will check if the cell already contains the ROUND function and skip it if it does. I have that part working with the If Not Instr..., but I want to get it to replace whatever place the cell was previously being rounded to with the new Roundto value.

For example, a cell that currently has =ROUND(34.673846,0) I want to change to =ROUND(34.673846,Roundto). See what I have below, and thanks for any help


Sub roundcells()
Roundto = InputBox("Round to How many Places?", "Round!", 0)
Roundto = CLng(Roundto)


Dim rCell As Range
Dim sFormula As String


For Each rCell In Application.Selection.Cells
If Not IsEmpty(rCell) Then


If Not InStr(1, rCell.Formula, "=ROUND") <> 0 Then


If IsNumeric(rCell) Then
sFormula = rCell.FormulaR1C1


If rCell.HasFormula Then _
sFormula = Mid(sFormula, 2)
sFormula = "=round(" & sFormula & "," & Roundto & ")"


If rCell.HasArray Then
rCell.FormulaArray = sFormula


Else
rCell.FormulaR1C1 = sFormula
End If
End If
End If
End If




Next rCell
End Sub

 

[Rick Rothstein]

I've been piecing together the below macro to insert a round function across a range of cells (Excel 2007). It just asks how many places to round to and drops in the formula on any cells with a value or formula. I am trying to add a level that will check if the cell already contains the ROUND function and skip it if it does. I have that part working with the If Not Instr..., but I want to get it to replace whatever place the cell was previously being rounded to with the new Roundto value.

For example, a cell that currently has =ROUND(34.673846,0) I want to change to =ROUND(34.673846,Roundto). See what I have below, and thanks for any help


Sub roundcells()
Roundto = InputBox("Round to How many Places?", "Round!", 0)
Roundto = CLng(Roundto)


Dim rCell As Range
Dim sFormula As String


For Each rCell In Application.Selection.Cells
If Not IsEmpty(rCell) Then


If Not InStr(1, rCell.Formula, "=ROUND") <> 0 Then


If IsNumeric(rCell) Then
sFormula = rCell.FormulaR1C1


If rCell.HasFormula Then _
sFormula = Mid(sFormula, 2)
sFormula = "=round(" & sFormula & "," & Roundto & ")"


If rCell.HasArray Then
rCell.FormulaArray = sFormula


Else
rCell.FormulaR1C1 = sFormula
End If
End If
End If
End If




Next rCell
End Sub

I think replacing the two red highlighted code lines with this...

sFormula = Replace(sFormula, ",0)", "," & RoundTo & ")")

will do what you want. However, I am not sure why you are assigning the formula back to the FormulaArray property (green highlight) as the formula you said you have in the cell does not look like an array formula.

 

[Scott Huish]

How about just this:

Sub test()
Dim x As Long, c As Range
x = Application.InputBox("Round to how many decimal places?", Type:=1)
For Each c In Selection
    If c.HasArray Then
        c.FormulaArray = "=ROUND(" & Mid(c.Formula, 2) & "," & x & ")"
    ElseIf c.HasFormula Then If InStr(c.Formula, "=ROUND") = 0 Then c.Formula = "=ROUND(" & Mid(c.Formula, 2) & "," & x & ")"
    End If
Next
End Sub