Abstract

You need to find the right banknotes and coins to make up a given cash amount?

sbmincash

The function below might return with an error value, though:

  • xlErrNum - The input amount or a face value of a banknote or a coin has more than 2 decimal places
  • xlErrValue - A face value of a banknote or a coin is negative or not valid
  • xlErrNull - No banknotes nor coins given
  • xlErrNA - There is no solution

Known limitation: In some less fortunate cases such as banknotes with face values 1, 6, and 10 the cash amount 13 will come out as 10, 1, 1, 1, and not as 6, 6, 1. Good message: This will not happen for normal cases of face values 1000, 500, 200, 100, 50, 20, 10, 5, 2, 1, 0.50, 0.20, 0.10, 0.05, 0.02, and 0.01.

But just in case you need to check whether sbMinCash has produced the minimum number of banknotes and coins - you might need to multiply all inputs by 100 if your original input values have decimal places since this algorithm is an integer only one:

Please read my Disclaimer.

Option Explicit

Function minCoins(V As Long, coins As Variant) As Variant
'Source: https://www.geeksforgeeks.org/find-minimum-number-of-coins-that-make-a-change/
'Adapted to VBA by Bernd Plumhoff  15-Jan-2023 PB V0.1
Dim i As Integer, j As Integer, sub_res As Integer
Dim vCoins As Variant
With Application.WorksheetFunction
If V <> Int(V) Then
    minCoins = CVErr(xlErrNum)
    Exit Function
End If
vCoins = .Transpose(.Transpose(coins))
ReDim tabl(0 To V + 1) As Long
tabl(V + 1) = UBound(vCoins)
tabl(0) = 0
For i = 1 To V
    tabl(i) = 65536 'Do not use type Long. 2147483647 you cannot wait for.
Next i
For i = 1 To V
    For j = 1 To UBound(vCoins, 1)
        If vCoins(j, 1) <= i Then
            sub_res = tabl(i - vCoins(j, 1))
            If sub_res <> 65536 And _
                sub_res + 1 < tabl(i) Then
                tabl(i) = sub_res + 1
            End If
        End If
    Next j
Next i
   
If tabl(V) = 65536 Then
    minCoins = CVErr(xlErrNA)
Else
    minCoins = tabl(V)
End If
End With
End Function

See also

The function sbMinCash is related to the accounts receivable problem.

Appendix – sbMinCash Code

Please read my Disclaimer.

Option Explicit

Function sbMinCash(dAmount As Variant, vNotesCoins As Variant) As Variant
'Returns the minimum number of given notes and coins to make up dAmount
'in a two-dimensional vertical array, for example for dAmount = 255.40 and
'vNotesCoins = {500.2;200.2;100.2;50.2;20.2;10.2;5.2;2.2;1.2;0,5.2;0,2.2;0,1.2;0,05.2;0,02.2;0,01.2}
'the result would be:
'200   1
' 50   1
'  5   1
'  0.2 2
'If you omit the second dimension of vNotesCoins - that is, if you do not provide
'the number of available banknotes and coins (just their face value) then the
'program would assume unlimited supply.
'Return error values:
'xlErrNum -   dAmount or a face values in vNotesCoins have more than 2 decimal places
'xlErrValue - A face value in vNotesCoins is negative
'xlErrNull -  No value in vNotesCoins given
'xlErrNA -    There is no solution
'Known limitation: In some less fortunate cases such as banknotes with
'amounts 1, 6, and 10 the cash amount 13 will result in 10, 1, 1, 1,
'and not in 6, 6, 1.
'Source (EN): http://www.sulprobil.de/sbmincash_en/
'Source (DE): http://www.berndplumhoff.de/sbmincash_de/
'(C) (P) by Bernd Plumhoff  15-Jan-2023 PB V0.5
Dim lAmount100 As Long 'dAmount x 100 to be able to apply integer calc
Dim i As Long, j As Long, k As Long

With Application.WorksheetFunction
If dAmount * 100# <> Int(dAmount * 100#) Then
    sbMinCash = CVErr(xlErrNum)
    Exit Function
End If
vNotesCoins = .Transpose(.Transpose(vNotesCoins))
ReDim lNC100(1 To UBound(vNotesCoins, 1)) As Long

'Fill integer array with 100 x non-empty notes and coins set
i = 1
j = 1
Do While i <= UBound(vNotesCoins, 1)
    If vNotesCoins(i, 1) >= 0 Then
        lNC100(j) = Int(vNotesCoins(i, 1) * 100# + 0.5)
        If lNC100(j) / 100# <> vNotesCoins(i, 1) Then
            sbMinCash = CVErr(xlErrNum)
            Exit Function
        End If
        j = j + 1
    Else
        sbMinCash = CVErr(xlErrValue)
        Exit Function
    End If
    i = i + 1
Loop
If j = 1 Then
    sbMinCash = CVErr(xlErrNull)
    Exit Function
End If

ReDim Preserve lNC100(1 To j - 1) As Long
ReDim vR(0 To 1, 1 To j - 1) As Variant
'Sort notes and coins, highest value first
For i = 1 To UBound(lNC100, 1) - 1
    For j = i + 1 To UBound(lNC100, 1)
        If lNC100(i) < lNC100(j) Then
            k = lNC100(i)
            lNC100(i) = lNC100(j)
            lNC100(j) = k
        End If
    Next j
Next i

lAmount100 = Int(dAmount * 100# + 0.5)
j = 1
i = 1
Do While lAmount100 > 0 And lNC100(i) > 0
    k = lAmount100 \ lNC100(i)
    If UBound(vNotesCoins, 2) > 1 Then
        If k > vNotesCoins(i, 2) Then
            k = vNotesCoins(i, 2)
        End If
    End If
    If k > 0 Then
        vR(0, j) = lNC100(i) / 100#
        vR(1, j) = k
        j = j + 1
        lAmount100 = lAmount100 - k * lNC100(i)
    End If
    i = i + 1
    If i > UBound(lNC100, 1) Then Exit Do
Loop
If lAmount100 <> 0 Then
    sbMinCash = CVErr(xlErrNA)
Else
    ReDim Preserve vR(0 To 1, 1 To j - 1)
    sbMinCash = .Transpose(vR)
End If
End With
End Function

Download

Please read my Disclaimer.

sbMinCash.xlsm [21 KB Excel file, open and use at your own risk]