“Every fool can know. The point is to understand.” [Albert Einstein]
Abstract
Rounded values do not add up to their rounded sum as demonstrated here. How can you ensure that the sum of rounded percentages equals exactly 100%? Is it possible to make sure that, for accounting purposes, the distribution of overhead costs precisely matches the original total? These issues are well-known and have been studied for a long time. This article presents a simple solution using Excel / VBA. The function introduced can round relative values (percentages) to exactly 100%, and it can round absolute values (such as cost distributions) while preserving the original rounded sum. A parameter allows you to choose which type of error to minimize — absolute error or relative error — compared to common half-up rounding.
Percentage Example
For example, the values 11, 45, and 555, which sum to 611, do not yield a percentage total of 100.00 but rather 99.99 if rounded to two decimal places. The bold values in non-sum cells have been adjusted using the RoundToSum function:
Values | Percent | Minimize absolute Error | Minimize relative Error | |
---|---|---|---|---|
11 | 1.80 | 1.80 | 1.80 | |
45 | 7.36 | 7.37 | 7.36 | |
555 | 90.83 | 90.83 | 90.84 | |
Sum | 611 | 99.99 | 100.00 | 100.00 |
The Excel / VBA function call RoundToSum({11,45,555},2,FALSE) would result in {1.80,7.37,90.83}, though. Here, the percentage value 7.364975 is rounded differently to achieve a percentage sum of 100.00 and to minimize the absolute error compared to half-up rounding. By using RoundToSum({11,45,555},2,FALSE,2) we would have received {1.80,7.36,90.84}, as this would minimize the relative error.
Example with Absolute Values
The sum of the second column differs by +2,000 from the rounded sum. The bold values in non-sum cells have been adjusted using the RoundToSum function:
Minimize Absolute Error | Minimize Relative Error | |||
---|---|---|---|---|
Values | Round to 1,000 | RoundToSum (…,-3,…,1) | RoundToSum (…,-3,…,2) | |
4,523 | 5,000 | 5,000 | 5,000 | |
456 | 0 | 0 | 0 | |
-78,845 | -79,000 | -79,000 | -79,000 | |
-14,491 | -14,000 | -15,000 | -14,000 | |
65,789 | 66,000 | 66,000 | 66,000 | |
129,512 | 130,000 | 129,000 | 129,000 | |
15,562 | 16,000 | 16,000 | 16,000 | |
548,555 | 549,000 | 549,000 | 548,000 | |
1,590 | 2,000 | 2,000 | 2,000 | |
-897 | -1,000 | -1,000 | -1,000 | |
6,968 | 7,000 | 7,000 | 7,000 | |
2,987 | 3,000 | 3,000 | 3,000 | |
Sum | 681,709 | 684,000 | 682,000 | 682,000 |
Example of a more Complex Application: Allocation of Overheads
Comparison of RoundToSum versus Other “Simpler” Methods
See RoundToSum (VBA) vs Other Methods.
Comparison of RoundToSum versus sbDHondt
RoundToSum implements the Hare-Niemeyer method, which is, in some ways, superior to the D’Hondt method when distributing parliament seats fairly. See sbDHondt.
Example of how to Deal with the Alabama Paradoxon: Fair Staff Selection based on Team Size
See Fair Staff Selection for Special Tasks based on Team Sizes.
Example for the Exact Relation of Random Numbers
See sbExactRandHistoGrm (VBA).
The Excel / VBA Function RoundToSum
Name
RoundToSum – Rounding values preserving their rounded sum
Synopsis
RoundToSum(vInput, [lDigits], [bAbsSum], [lErrorType], [bDontAmend])
Description
RoundToSum rounds values without altering their rounded sum. It uses the largest remainder method to minimize the error compared to the commonly used half-up rounding method. If the error is identical for one or more values, the first value(s) encountered will be adjusted.
Note: This solution is limited to one-dimensional tables without subtotals. There is no general solution for higher-dimensional tables or tables with subtotals.
Parameters
vInput – Range or array containing the unrounded input values.
lDigits – Optional, default value is 2. The number of digits to round to. For example: 0 rounds to integers, 2 rounds to the nearest cent, -3 rounds to the nearest thousand.
bAbsSum – Optional, default value is TRUE. TRUE rounds the values directly. FALSE adjusts the percentages so they sum to exactly 100%.
lErrorType – Optional, default value is 1. The type of error to minimize: 1 for absolute error, 2 for relative error.
bDontAmend – Optional, default value is FALSE. TRUE prevents adjusting the values to match the rounded sum. FALSE makes adjustments as described above. This parameter is mainly for demonstration purposes to see the function’s impact.
Literature
Diaconis, P., & Freedman, D. (2007, July 13). Diaconis, P., & Freedman, D. (2007, July 13). (External link!) On Rounding Percentages.
Sande, G. (2005, August 7). (External link!) Guaranteed Controlled Rounding for Many Totals in Multi-way and Hierarchical Tables.
Appendix – RoundToSum Code
Please read my Disclaimer.
Option Explicit
Enum mc_Macro_Categories
mcFinancial = 1
mcDate_and_Time
mcMath_and_Trig
mcStatistical
mcLookup_and_Reference
mcDatabase
mcText
mcLogical
mcInformation
mcCommands
mcCustomizing
mcMacro_Control
mcDDE_External
mcUser_Defined
mcFirst_custom_category
mcSecond_custom_category 'and so on
End Enum 'mc_Macro_Categories
Function RoundToSum(vInput As Variant, Optional lDigits As Long = 2, Optional bAbsSum As Boolean = True, _
Optional lErrorType As Long = 1, Optional bDontAmend As Boolean = False) As Variant
'Calculate rounded summands which exactly add up to the rounded sum of unrounded summands.
'It uses the largest remainder method which minimizes the error to the original unrounded summands.
'V2.0 PB 26-Nov-2022 (C) (P) by Bernd Plumhoff
Dim i As Long, j As Long, k As Long, n As Long, lCount As Long, lSgn As Long
Dim d As Double, dDiff As Double, dRoundedSum As Double, dSumAbs As Double: Dim vA As Variant
With Application.WorksheetFunction
vA = .Transpose(.Transpose(vInput)): On Error GoTo Errhdl: i = vA(1) 'Force error in case of vertical arrays
On Error GoTo 0: n = UBound(vA): ReDim vC(1 To n) As Variant, vD(1 To n) As Variant: dSumAbs = .Sum(vA)
For i = 1 To n
d = IIf(bAbsSum, vA(i), vA(i) / dSumAbs * 100#): vC(i) = .Round(d, lDigits)
If lErrorType = 1 Then 'Absolute error
vD(i) = vC(i) - d
ElseIf lErrorType = 2 Then 'Relative error
vD(i) = (vC(i) - d) * d
Else
RoundToSum = CVErr(xlErrValue): Exit Function
End If
Next i
If Not bDontAmend Then
dRoundedSum = .Round(IIf(bAbsSum, dSumAbs, 100#), lDigits)
dDiff = .Round(dRoundedSum - .Sum(vC), lDigits)
If dDiff <> 0# Then
lSgn = Sgn(dDiff): lCount = .Round(Abs(dDiff) * 10 ^ lDigits, 0)
'Now find highest (lowest) lCount indices in vC
ReDim m(1 To lCount) As Long
For i = 1 To lCount: m(i) = i: Next i
For i = 1 To lCount - 1
For j = i + 1 To lCount
If lSgn * vD(i) > lSgn * vD(j) Then k = m(i): m(i) = m(j): m(j) = k
Next j
Next i
For i = lCount + 1 To n
If lSgn * vD(i) < lSgn * vD(m(lCount)) Then
j = lCount - 1
Do While j > 0
If lSgn * vD(i) >= lSgn * vD(m(j)) Then Exit Do
j = j - 1
Loop
For k = lCount To j + 2 Step -1: m(k) = m(k - 1): Next k: m(j + 1) = i
End If
Next i
For i = 1 To lCount: vC(m(i)) = .Round(vC(m(i)) + dDiff / lCount, lDigits): Next i
End If
End If
RoundToSum = vC
If TypeName(Application.Caller) = "Range" Then
If Application.Caller.Rows.Count > Application.Caller.Columns.Count Then
RoundToSum = .Transpose(vC) 'It's two-dimensional with 2nd dim const = 1
End If
End If
Exit Function
Errhdl:
'Transpose variants to be able to address them with vA(i), not vA(i,1)
vA = .Transpose(vA): Resume Next
End With
End Function
Sub DescribeFunction_sbRoundToSum()
'Run this only once, then you will see this description in the function menu
Dim FuncName As String, FuncDesc As String, Category As String, ArgDesc(1 To 5) As String
FuncName = "RoundToSum"
FuncDesc = "Rounding values preserving their rounded sum"
Category = mcMath_and_Trig
ArgDesc(1) = "Range or array which contains unrounded values"
ArgDesc(2) = "[Optional = 2] Number of digits to round to. For example: 0 rounds to integers, 2 rounds to the cent, -3 will use thousands"
ArgDesc(3) = "[Optional = True] True takes the summands as they are; False works on the summands' percentages to make all percentages add up to 100% exactly"
ArgDesc(4) = "[Optional = 1] Error type: 1= absolute error, 2 = relative error"
ArgDesc(5) = "[Optional = False] True does not amend the rounded summands to match the rounded sum; False performs the calculation as described"
Application.MacroOptions _
Macro:=FuncName, _
Description:=FuncDesc, _
Category:=Category, _
ArgumentDescriptions:=ArgDesc
End Sub
Download
Please read my Disclaimer.
roundtosum.xlsm [63 KB Excel file, open and use at your own risk]