2

cells are:

3.141516
=10/6
=rand()
or blank
etc...

result:

=ROUND(3.141516,1)
=ROUND(10/6,1)
=ROUND(RAND(),1)

and if blank - leave blank (not ROUND(,1) )

and I would like to choose range, and decimal by InputBox or something

I found how to add ROUND() around formula, around Constants, with blank cells, with inputbox but all in a separate code, not together. I am not vba hero so I need help. thank you :)

Sub RoundNum()
Dim Rng As Range
Dim WorkRng As Range
Dim xNum As Integer
On Error Resume Next
xTitleId = "Round Numbers"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xNum = Application.InputBox("Decimal", xTitleId, Type:=1)
For Each Rng In WorkRng
    Rng.Value = Application.WorksheetFunction.Round(Rng.Value, xNum)
Next
End Sub
Sub Makro1()
Dim Str As String
For Each cell In Selection
Str = cell.FormulaR1C1
If Mid(Str, 1, 1) = "=" Then Str = Mid(Str, 2)
cell.FormulaR1C1 = "=ROUND(" & Str & ",1)"
Next cell
End Sub

on the end I did something like this:

Sub rRoundIt()
Dim rng As Range
Dim rngArea As Range
Dim AppCalc As Long
On Error Resume Next
With Application
    AppCalc = .Calculation
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
Set rng = Union(Selection.SpecialCells(xlCellTypeFormulas, xlNumbers), _
                Selection.SpecialCells(xlCellTypeConstants, xlNumbers))
For Each rngArea In rng
    If Left(rngArea.Formula, 7) <> "=ROUND(" Then _
        rngArea.Formula = "=ROUND(" & Replace(rngArea.Formula, Chr(61), vbNullString) & ", 1)"
Next rngArea
With Application
    .ScreenUpdating = True
    .Calculation = AppCalc
End With
End Sub

thank you Jeeped :)

sandy
  • 23
  • 5

1 Answers1

1

This short sub takes advantage of the Range.SpecialCells method using both the xlCellTypeConstants and xlCellTypeFormulas options from xlCellType Enumeration. The .SpecialCells are further filtered by only garnering those constants or formulas that result in numbers with the xlNumbers option.

Sub roundIt()
    Dim r As Range, rng As Range
    With Worksheets("Sheet1")
        With .UsedRange.Cells
            Set rng = Union(.SpecialCells(xlCellTypeFormulas, xlNumbers), _
                            .SpecialCells(xlCellTypeConstants, xlNumbers))
            For Each r In rng
                If Left(r.Formula, 7) <> "=ROUND(" Then _
                    r.Formula = "=ROUND(" & Replace(r.Formula, Chr(61), vbNullString) & ", 1)"
            Next r
        End With
    End With
End Sub

Ideally, you would want to offer some error control in case there are no formulas or constants within the worksheet's .UsedRange property that represent numbers. If there are none to be found, then that .SpecialCells will return nothing.

By concentrating on only those cells which could posses a numerical value to apply a ROUND function to, you should shorten the iterations of your loop through the cells in the worksheet substantially.

  • It works fine :) but do I really need declare With Worksheets("Sheet1") ? – sandy Dec 08 '15 at 15:35
  • If you would prefer to work with a group of selected cells ([Application.Selection](https://msdn.microsoft.com/en-us/library/office/ff840834.aspx) property) then have a look at the methods of referencing the Selection detailed [here](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros/28700020?s=1|0.0000#28700020). You should have no trouble combining the two. –  Dec 08 '15 at 15:43
  • I added end code to original post, maybe it is not elegant but works :) – sandy Dec 08 '15 at 16:35