Private Sub cmbCalculate_Click()

Dim dGoal As Double
Dim dTolerance As Double
Dim dAmounts() As Double
Dim vResult As Variant
Dim m As Long
Dim n As Long

With Me
   
    dGoal = .Range("B2")
    dTolerance = .Range("C2")
    ReDim dAmounts(1 To 100)
    For m = 2 To 101
        If (.Cells(m, 1) <> "") And (IsNumeric(.Cells(m, 1))) Then
            dAmounts(m - 1) = .Cells(m, 1)
        Else
            ReDim Preserve dAmounts(1 To m - 1)
            Exit For
        End If
    Next
    ReDim Preserve dAmounts(1 To UBound(dAmounts) - 1)
  
    vResult = Combinations(dAmounts, dGoal, dTolerance)
    Application.ScreenUpdating = False
    .Range("D3:D65536").ClearContents
    .Range(.Cells(3, 4), .Cells(UBound(vResult) + 3, 4)) = vResult
    Application.ScreenUpdating = True

End With

End Sub
	
Function Combinations( _
   Elements As Variant, _
   Goal As Double, _
   Optional Tolerance As Double, _
   Optional SoFar As Variant, _
   Optional Position As Long) As Variant
  
Dim i             As Long
Dim k             As Long
Dim dCompare  As Double
Dim dDummy      As Double
Dim vDummy      As Variant
Dim vResult     As Variant

If Not IsMissing(SoFar) Then

   'Sum of elements so far
   For Each vDummy In SoFar
      dCompare = dCompare + vDummy
   Next
  
Else

   'Start elements sorted by amount
   For i = 1 To UBound(Elements)
       For k = i + 1 To UBound(Elements)
           If Elements(k) < Elements(i) Then
               dDummy = Elements(i)
               Elements(i) = Elements(k)
               Elements(k) = dDummy
           End If
       Next
   Next
  
   Set SoFar = New Collection
  
End If

If Position = 0 Then Position = LBound(Elements)
For i = Position To UBound(Elements)

   'Add current element
   SoFar.Add Elements(i)
   dCompare = dCompare + Elements(i)
  
   If Abs(Goal - dCompare) < (0.001 + Tolerance) Then
  
      'Goal achieved
      k = 0
      ReDim vResult(0 To SoFar.Count - 1, 0)
      For Each vDummy In SoFar
         vResult(k, 0) = vDummy
         k = k + 1
      Next
      Combinations = vResult
      Exit For
     
   ElseIf dCompare < (Goal + 0.001 + Tolerance) Then
      'Enough room for another element
      'Call recursively starting with next higher amount
      vResult = Combinations(Elements, Goal, Tolerance, SoFar, i + 1)
      If IsArray(vResult) Then
         Combinations = vResult
         Exit For
      Else
         SoFar.Remove SoFar.Count
         dCompare = dCompare - Elements(i)
      End If
     
   Else
  
      'Amount too high
      SoFar.Remove SoFar.Count
      Exit For
     
   End If
  
Next 'Try next higher amount

End Function