#1
|
|||
|
|||
Combinations calculator in excel??? Macro??
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.) |
#2
|
||||
|
||||
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.
Code:
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Nested Looping all combinations of four items | lhoffmeyer | Excel Programming | 1 | 11-30-2012 03:09 PM |
Excel eBay Fee Calculator Formula | rdonovan1 | Excel | 1 | 09-10-2012 07:37 PM |
Separate the digits into 3 combinations | Jasa P | Word VBA | 1 | 08-19-2012 11:04 PM |
Excel Calculator | Mandusin | Excel | 6 | 12-25-2010 07:34 AM |
Age Calculator in MS Outlook 2002 SP3 | turns | Outlook | 0 | 06-15-2010 12:26 AM |