Any suggestions with cutting and pasting the two examples above?

‘/========================/
Sub Rounding_Wrap()
‘Wrap ‘Round’ function with user decided decimals around numbers _
and formulas only
Dim blnNumber As Boolean
Dim objCell As Object, objInput As Object
Dim strOriginalAddress As String
Dim strvarInputAddress As String
Dim strOrigCalcStatus As String
Dim varInput As Variant
Dim varRounding As Variant

On Error GoTo err_Sub

‘save calculation setting
Select Case Application.Calculation
Case xlCalculationAutomatic
strOrigCalcStatus = “Automatic”
Case xlCalculationManual
strOrigCalcStatus = “Manual”
Case xlCalculationSemiautomatic
strOrigCalcStatus = “SemiAutomatic”
Case Else
strOrigCalcStatus = “Automatic”
End Select

blnNumber = False
strOriginalAddress = Selection.Address

Set varInput = _
Application.InputBox(prompt:= _
“Select Range of Numbers to be rounded “, _
Default:=strOriginalAddress, Type:=8)

‘get how many cells have been selected and location
strvarInputAddress = varInput.Address

‘check to see if any cells have been selected
If varInput.Count = 0 Then
MsgBox “Nothing Selected…” & vbCr & vbCr & _
“Rounding procedure discontinued…”, _
vbExclamation + vbOKOnly, “Warning…”
GoTo exit_Sub
End If

‘ask for rounding precision
varRounding = _
Application.InputBox(prompt:= _
“Enter Number of places for cells to be rounded “, _
Default:=2, Type:=1)

‘check to see if a number was entered for rounding precision
If Asc(varRounding) <> 48 Then
If Len(varRounding) = 0 Or varRounding > 100 _
Or varRounding = False Then
MsgBox “Rounding Amount Problem Encountered…” & _
vbCr & vbCr & _
“Rounding procedure discontinued…”, _
vbExclamation + vbOKOnly, “Warning…”
GoTo exit_Sub
End If
End If

‘only look in used area of the worksheet
Set varInput = Intersect(varInput.Parent.UsedRange, varInput)

‘create round formula
Application.Calculation = xlManual
For Each objCell In varInput

‘check if cell is a value
Select Case UCase(TypeName(objCell.value))
Case “BYTE”
blnNumber = True
Case “CURRENCY”
blnNumber = True
Case “DECIMAL”
blnNumber = True
Case “DOUBLE”
blnNumber = True
Case “INTEGER”
blnNumber = True
Case “LONG”
blnNumber = True
Case “SINGLE”
blnNumber = True
Case Else
blnNumber = False
End Select

‘if cell is a value in the used area, continue
If blnNumber = True Then
Select Case Asc(Left(objCell.Formula, 1))
Case 45 ‘minus (-) sign
objCell.Formula = _
“=ROUND(” & _
objCell.Formula & “,” & varRounding & “)”
Case 48 To 57 ‘numbers 0 thru 9
objCell.Formula = _
“=ROUND(” & _
objCell.Formula & “,” & varRounding & “)”
Case 61 ‘equal (=) sign
objCell.Formula = _
“=ROUND(” & _
Right(objCell.Formula, _
Len(objCell.Formula) – 1) & _
“,” & varRounding & “)”
End Select
End If

Next objCell

exit_Sub:
Set varInput = Nothing

‘re-set to original calculation method
Select Case strOrigCalcStatus
Case “Automatic”
Application.Calculation = xlCalculationAutomatic
Case “Manual”
Application.Calculation = xlCalculationManual
Case “SemiAutomatic”
Application.Calculation = xlCalculationSemiautomatic
Case Else
Application.Calculation = xlCalculationAutomatic
End Select

Exit Sub

err_Sub:
MsgBox “Error encountered…” & _
vbCr & vbCr & _
“Rounding procedure discontinued…”, _
vbExclamation + vbOKOnly, “Warning…”
GoTo exit_Sub

End Sub
‘/========================/

I use the ROUND() function extensively for that reason. I don’t always round to the same number of decimals, either; I use 0, 2 and 4 decimals pretty equally. I got sick of adding the function by hand, so I wrote some code that would do it for me in a snap. I’m posting it below:

Sub rounder(arg As Integer)
Dim cell As Range
Dim short_form As String, long_form As String
On Error GoTo Error
For Each cell In Selection
If cell.Formula <> “” Then
If (Left(cell.Formula, 1)) = “=” Then
If (Mid(cell.Formula, 2, 5)) = “ROUND” Then
short_form = Mid(cell.Formula, 8, Len(cell.Formula) – 10)
Else
short_form = Right(cell.Formula, (Len(cell.Formula) – 1))
End If
Else
short_form = cell.Formula
End If
long_form = “=round(” & short_form & “,” & arg & “)”
cell.Formula = long_form
End If
Next
Exit Sub
Error:
Exit Sub
End Sub

It’s called using these bits of code (which I call from a custom toolbar I created):

Sub round4()
Call rounder(4)
End Sub

Sub round2()
Call rounder(2)
End Sub

Sub round0()
Call rounder(0)
End Sub

And if I want to remove the rounding feature, I have this code:

Sub remove_round()
Dim cell As Range
Dim short_form As String, long_form As String
On Error GoTo Error
For Each cell In Selection
If cell.Formula <> “” Then
If (Left(cell.Formula, 1)) = “=” Then
If (Mid(cell.Formula, 2, 5)) = “ROUND” Then
short_form = Mid(cell.Formula, 8, Len(cell.Formula) – 10)
long_form = “=” & short_form
cell.Formula = long_form
End If
End If
End If
Next
Exit Sub
Error:
Exit Sub
End Sub

I’m not sure if this is good code, but it saves me time every day. Time that can be better spent perusing the goldmine that is DDOE!