VBA for Summing Numbers - Combinations

[adamp1027]

Hello,

I have this VBA (below) which will allow the summing of a list of numbers to reach a stated number.

When using =getcombination(A2:A9,C2) for example, where A2:A9 is a list of numbers, and C2 is the desired sum

However, the result is only 1 possible combination (and usually not a desired one). Is there a way to modify the VBA so the 1 combination shown is the result with the fewest number of combinations?

Function GetCombination(CoinsRange As Range, SumCellId As Double) As String

     Dim xStr As String
     Dim xSum As Double
     Dim xCell As Range

     xSum = SumCellId

     For Each xCell In CoinsRange
         If Not (xSum / xCell < 1) Then
             xStr = xStr & Int(xSum / xCell) & " of " & xCell & "  "
             xSum = xSum - (Int(xSum / xCell)) * xCell
         End If
     Next

     GetCombination = xStr

End Function

 

[Phuynh]

First, I'm not "expert", but I think the following snipet look very similar to what you wrote but using ParamArray instead of Range.
Don't know if this help!

Phh

Public Function sumtoimpa(ParamArray Xrange() As Variant) As String
  Dim sumArray As Double, argRdNum As Double
  Dim theVal As Variant
  Dim I As Integer
  For I = LBound(Xrange) To UBound(Xrange)
   If TypeOf Xrange(I) Is Range Then
   For Each theVal In Xrange(I)
    sumArray = sumArray + todec(CStr(theVal))
   Next theVal
   Else
    sumArray = sumArray + CDbl(Xrange(I))
   End If
  Next
  argRdNum = (1 / 512)
  sumArray = Excel.WorksheetFunction.Round(sumArray / argRdNum, 0) * argRdNum
  If sumArray <= -12 Or sumArray >= 12 Then
    sumtoimpa = (Fix(sumArray / 12)) & "'-" & Excel.WorksheetFunction.Text(Abs(sumArray - (12 * Fix(sumArray / 12))), "0 ##/####") & """"
  ElseIf sumArray < 12 And sumArray > -12 Then
    If (sumArray - Fix(sumArray)) = 0 Then
      sumtoimpa = sumArray & """"
    Else
      sumtoimpa = Excel.WorksheetFunction.Text(sumArray, "# ###/###") & """"
    End If
 End If
End Function