Combinations calculator in excel??? Macro??

[mkuderik]

Hello all looking for a formula? or file? or macro? i am not excel smart at all so please excuse the wording. i think best way would to give example. any info would be greatly appreciated.



Ex. i have $30.00 and there are 10 action figures available for purchase. I must buy 3 with no more than my $30.00.

this would be based on having 10 options and needing to know which groups of 3 i could buy at or below $30.00.

choices- based on dollars

figure 1- $12
2 - 11.5
3 - 11
4 - 9.8
5 - 10.8
6 - 9
7 - 8
8 - 10.5
9 - 11.2
10- 12.4

Now i would like to show me what my options would be at or below 30.
(1,6,7 ; 4,5,6 ; etc etc.)

[macropod]

The following macro checks all cell pairs and triplets in the selected rows and reports any that add up to the value stored in the nominated target cell. Finding all the combinations that add up to the maximum possible that is less than the target value adds a great deal more complexity.

Sub FindSubSets()
Application.ScreenUpdating = False
Dim a As Long, b As Long, c As Long, d As Long
Dim Target As String, Output As String
Dim x As Long, y As Long, z As Long
If Selection.Rows.Count = 1 Or Selection.Columns.Count <> 1 Then
  MsgBox "Please select more than one row in a single column"
  Exit Sub
End If
a = ActiveCell.Row
b = ActiveCell.Column
c = Selection.Rows.Count + ActiveCell.Row - 1
d = 0
Target = InputBox("What is the address of the cell" & vbCrLf & "you want the numbers to add up to?")
Output = InputBox("What is the address of the first cell" & vbCrLf & "you want to output the results in?")
On Error GoTo Abort
Range(Output).Offset(d, 0) = ""
For x = a To c
  For y = x + 1 To c
  If Cells(x, b) + Cells(y, b) = Range(Target).Value Then
    Range(Output).Offset(d, 0) = Addr(x, b) + "+" + Addr(y, b)
    d = d + 1
  Else
    For z = y + 1 To c
    If Cells(x, b) + Cells(y, b) + Cells(z, b) = Range(Target).Value Then
      Range(Output).Offset(d, 0) = Addr(x, b) + "+" + Addr(y, b) + "+" + Addr(z, b)
      d = d + 1
    End If
    Next z
  End If
  Next y
Next x
Range(Output).Offset(d, 0) = ""
Abort:
Application.ScreenUpdating = False
End Sub
Private Function Addr(ByVal n As Long, ByVal m As Long) As String
  Addr = Cells(n, m).Address(False, False)
End Function