Insert circular function into current cell using VBA

Question

I am trying to simplify the insertion of the Round function into several cells that already have formulas.

For example, if cell A1 has the formula =b1+b2 , after using this macro, I want the contents of the cell to read =Round(b1+b2,) . The formulas in each of the cells do not match, so the b1+b2 should be anything.

All I can do is the following:

 Sub Round() Activecell.FormulaR1C1 = "=ROUND(b1+b2,)" End Sub 

So, I was really looking for a way to get the formula in the selected cell, and then edited that content using VBA. I can not 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 based on the Brettville approach to the code I wrote on another forum , which

• Works in all formula cells in current selection

• Uses arrays, special and string functions to optimize speed. Cycle 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

On the second function, " =round " dials " =Rround ". After changing from a round of 2 instead of 1, the process worked fine for me. I can add an if to another to check if the " =round " formula already exists so that someone doesn't run more than once or rounds off in a round.

Darryl

Answer 4

A completely modified program will 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 it

For each n in the choice N.formula = "round (" and mid (n.formula, 2100) and ", 1)" Next n

I assumed that your existing formula is less than 100 characters long and sensitivity is 1. You can change these values

Answer 6

I 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 required instead of editing the code
• Enter the number of digits for the different regions selected by changing the order of the iNum strings as described.

Hello,

  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