Abstract
You need to find the right banknotes and coins to make up a given cash amount?
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]