Force Rounding to Equal the Sum

Question

I work for a large company that presents rounded numbers in its financial statements. Of course, the rounded numbers do not always equal the total. I want the component number(s) that are closest to $0.50 to be rounded up or down so that the column equals the total.

As an example, if I have the numbers 5.43, 4.26, and 6.32, they total 16.01. Rounded, they would be 5, 4, and 6 and the total would be 15. I want the total to be rounded to 16 and the closest amount to $X.50 to round the necessary way. In this case, it would be the 5.43 rounding to 6 rather than 5.

The following code was written for me by T.M. and it works on his machine, but not on mine. He is using Excel 2010 and I am using Excel 2013. Whenever I try to execute the code I get an error that says

Compile Error: Wrong number of arguments or invalid property assignment.

After I click the OK button, the debugger highlights the word Format in blue. The highlighted word Format is found in the line of code right before the End If command in Section I c).

When I was attempting to test the code, I was using a column of 870 amounts and the rounded total was $21.44 off from the actual total. That means I would need 21 or 22 of the 870 numbers to be rounded the "wrong" way. If anyone can come up with a solution, I would greatly appreciate it. Thank you!

Sub MurrayRound()
'
' MurrayRound Macro
' Rounds Murray's figures for budget.
  Dim s As String
  Dim v, vx     As Variant
  Dim ii  As Long
  Dim total As Double, rounded As Double, diff As Double, diffrest As Double, cent As Double
  Dim i     As Long, j As Long, n As Long
  Dim ws    As Worksheet
  Set ws = ThisWorkbook.Worksheets("Rick")   ' << change to your sheet name
' --------------------------------------------------------------------
' I.  Get data for normal roundings and code absolute cent differences
' --------------------------------------------------------------------
' (a) get last row in column B containing data  '    (omitting last row with total sum!)
      n = ws.Range("B" & ws.Rows.Count).End(xlUp).Row - 1 ' << subtract 1 if last sum row!
' (b) get values (col.B-data, col.C-D temp) to one based 2dim array
      v = ws.Range("B2:D" & n).Value
      total = Application.Sum(Application.Transpose(Application.Index(v, 0, 1)))
' (c) loop through array to round (items count n - 1, as omitting one title row!)
      For i = 1 To n - 1
        ' round original values
          v(i, 2) = WorksheetFunction.Round(v(i, 1), 0)

        ' convert absolute cent differences 1-100 to chr codes and add item no
          v(i, 3) = Chr(64 + (0.51 - Abs(v(i, 2) - v(i, 1))) * 100) & Format(i, "0")

      End If

        ' overwrite original data in col2 with rounded values col1, AFTER coding!
          v(i, 1) = v(i, 2)
      Next i
' --------------------------------------------------------------------
' II. Calculate 'fudge'
' --------------------------------------------------------------------
      rounded = Application.Sum(Application.Transpose(Application.Index(v, 0, 2)))
      diff = WorksheetFunction.Round(rounded - total, 0)    ' resting difference
      diffrest = diff
' --------------------------------------------------------------------
' III. 'Fudge' resting difference using Filter function
' --------------------------------------------------------------------
  For j = 0 To 49                      ' absolute cent differences 0 to 49
      If diffrest = 0 Then Exit For    ' escape if no diffrest left
      s = Chr(64 + j)                  ' code differences from Chr(64)="A" to Chr(64+49)="q"
  '  (a) get zerobased 1-dim array via ' Filter function
      vx = Filter(Application.Transpose(Application.Index(v, 0, 3)), s)
  '  (b) Adapt roundings nearest to .50, .49, to .99 cents (i.e. j = 0, 1 to 49)
      For i = LBound(vx) To UBound(vx) ' loop through filter items
           ii = Val("0" & Replace(vx(i), s, "")) ' get coded Item index from filter array
           If ii <> 0 Then
              If diffrest <> 0 Then    ' remaining diffrest
                 cent = IIf(diffrest > 0, -1, 1) ' get fudge cent
                 v(ii, 1) = v(ii, 2) + cent      ' << new value = rounded +/- 1 cent
                 diffrest = WorksheetFunction.Round(diffrest + cent, 0)
               ' check escape condition: no remaining diffRest
                 If diffrest = 0 Then Exit For
               End If
           End If
      Next i
  Next j
' --------------------------------------------------------------------
' IV. Write results
' --------------------------------------------------------------------
' (a) redim to one column only (items count n - 1, as omitting title row)
      ReDim Preserve v(1 To n - 1, 1 To 1)
' (b) write back to B (or to ANY wanted column :-)
      ws.Range("C2:C" & n).Value = v



End Sub