Insert Round function into current cell using VBA - excel

Question

I'm trying to make it easier to insert the Round function into a number of cells that already have formulas in them.
For instance, if cell A1 has the formula =b1+b2, after the use of this macro, I want the cell contents to read =Round(b1+b2,). The formulas in each of the cells are not the same, so the b1+b2 portion has to be anything.
All I can get to is this:
Sub Round()
Activecell.FormulaR1C1 = "=ROUND(b1+b2,)"
End Sub
So I'm really looking for some way to get the formula in a selected cell, and then edit those contents using VBA. I can't find the answer anywhere.

Answer 1

How about this?
Sub applyRound(R As Range)
If Len(R.Formula) > 0 Then
If Left(R.Formula, 1) = "=" Then
R.Formula = "=round(" & Right(R.Formula, Len(R.Formula) - 1) & ",1)"
End If
End If
End Sub

Answer 2

This is a variation on brettville's approach base on code I wrote on another forum that
Works on all formula cells in the current selection
Uses arrays, SpecialCells and string functions to optimise speed. Looping through ranges can be very slow if you have many cells
Sub Mod2()
Dim rng1 As Range
Dim rngArea As Range
Dim i As Long
Dim j As Long
Dim X()
Dim AppCalc As Long
On Error Resume Next
Set rng1 = Selection.SpecialCells(xlFormulas)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
With Application
AppCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For Each rngArea In rng1.Areas
If rngArea.Cells.Count > 1 Then
X = rngArea.Formula
For i = 1 To rngArea.Rows.Count
For j = 1 To rngArea.Columns.Count
X(i, j) = "=ROUND(" & Right$(X(i, j), Len(X(i, j)) - 1) & ",1)"
Next j
Next i
rngArea = X
Else
rngArea.Value = "=Rround(" & Right$(rngArea.Formula, Len(rngArea.Formula) - 1) & ",1)"
End If
Next rngArea
With Application
.ScreenUpdating = True
.Calculation = AppCalc
End With
End Sub

Answer 3

Typo on the 2nd "=round" function was typed as "=Rround". Once modified with a round of 2, instead of 1, the process worked great for me. I may add in another if statement to check to see if there already is a "=round" formula to prevent someone from running more than once or rounding within a round.
Darryl

Answer 4

The full modified program would be like this
Sub Round_Formula()
Dim c As Range
Dim LResult As Integer
Dim leftstr As String
Dim strtemp As String
Set wSht1 = ActiveSheet
Dim straddress As String
Dim sheet_name As String
sheet_name = wSht1.Name
'MsgBox (sheet_name)
straddress = InputBox(Prompt:="Full cell Address where to insert round function as D8:D21", _
Title:="ENTER Address", Default:="D8:D21")
With Sheets(sheet_name)
For Each c In .Range(straddress)
If c.Value <> 0 Then
strtemp = c.Formula
'MsgBox (strtemp)
LResult = StrComp(Left(strtemp, 7), "=ROUND(", vbTextCompare)
'MsgBox ("The value of LResult is " & LResult)
If LResult <> 0 Then
'c.Formula = "=ROUND(" & Right(c.Formula, Len(c.Formula) - 1) & ",2)"
c.Formula = "=ROUND(" & Right(c.Formula, Len(c.Formula) - 1) & ",0)"
End If
End If
Next c
End With
End Sub

Answer 5

Try This
For each n in selection
N.formula="round (" & mid (n.formula,2,100) & ",1)"
Next n
I assumed your existing formula's length is less than 100 character and sensitivity is 1. You can change these values

Answer 6

I have improved the answer provided by Sumit Saha, to provide the following features:
Select a range or different ranges with the mouse
Enter the number of digits desired instead of editing the code
Enter the number of digits for different regions selected by changing line order of iNum as explained.
Regards,
Sub Round_Formula_EREX()
Dim c As Range
Dim LResult As Integer
Dim leftstr As String
Dim strtemp As String
Set wSht1 = ActiveSheet
Dim straddress As Range
Dim iNum As Integer
Set straddress = Application.Selection
Set straddress = Application.InputBox("Range", xTitleId, straddress.Address, Type:=8)
iNum = Application.InputBox("Decimal", xTitleId, Type:=1)
For Each c In straddress
If c.Value <> 0 Then
strtemp = c.Formula
LResult = StrComp(Left(strtemp, 7), "=ROUND(", vbTextCompare)
If LResult <> 0 Then
'If you want to enter different digits for different regions you have selected,
'activate next line and deactivate previous iNum line.
'iNum = Application.InputBox("Decimal", xTitleId, Type:=1)
c.Formula = "=ROUND(" & Right(c.Formula, Len(c.Formula) - 1) & "," & iNum & ")"
End If
End If
Next c
End Sub