Rounding all numbers in the selection to a fixed number of digits

Introduction

When doing analysis of measured data, it is customary to show the results in a fixed number of digits, called the significant digits. The number of digits depends on the accuracy of the measurement itself.

Whilst Excel has several methods to round your results, there is none that can handle rounding to a specified number of digits, one that is able to:

Round    1234567    to    1.23E+6
Round    1.234567    to    1.23
Round    0.001234567    to    0.00123

Of course you could use scientific notation (see screenshot), but in my experience many people (including executives reading your report) have a hard time understanding 1.23E-1, whereas understanding 0.123 is quite within reach.
Format cells dialog

Figure 1: Number format, Scientific notation

This is why I wrote this little subroutine, which rounds all numbers in the selection to the number of digits specified:

Sub RoundToDigits()
    Dim dDigits As Double
    Dim iCount As Integer
    Dim iRoundDigits As Integer
    Dim rArea As Range
    Dim rCell As Range
    Dim rRangeToRound As Range
    Dim sFormatstring As String
    Dim vAnswer As Variant
    On Error Resume Next
    Set rRangeToRound = Selection
    If rRangeToRound Is Nothing Then Exit Sub
    vAnswer = InputBox("How many digits?", "Rounding function")
    If TypeName(vAnswer) = "Boolean" Then Exit Sub
    If vAnswer = "" Then Exit Sub
    iRoundDigits = CInt(Application.Max(1, vAnswer))
    On Error GoTo 0
    For Each rArea In rRangeToRound.Cells
        For Each rCell In rArea
            If IsNumeric(rCell.Value) And rCell.Value <> "" Then
                sFormatstring = "0"
                If rCell.Value = 0 Then
                    dDigits = 3
                Else
                    dDigits = Log(Abs(rCell.Value)) / Log(10)
                    dDigits = -Int(dDigits) + iRoundDigits - 1
                    dDigits = Application.Min(Len(Abs(rCell.Value)), dDigits)
                End If
                If dDigits >= 1 Then
                    If Int(rCell.Value) = 0 Then
                        sFormatstring = sFormatstring & "." & String(dDigits - 1, "0")
                    Else
                        sFormatstring = sFormatstring & "." & String(dDigits, "0")
                    End If
                ElseIf dDigits < 0 Then
                    sFormatstring = sFormatstring & "." _
                    & String(iRoundDigits - 1, "0") & "E+00"
                End If
                rCell.NumberFormat = sFormatstring
            End If
        Next rCell
    Next rArea
End Sub

Listing 1: Code to change format of cells so they just show significant digits.

Acknowledgements

Thanks to Matthew Adams Rasmussen for correcting a small bug regarding rounding e.g. 0.995 to 0.100 instead of to 0.10 when rounding to 2 significant digits.

Comments

Loading comments...