Calculating Combinations

  • Thread starter Thread starter JimS
  • Start date Start date
J

JimS

1 .3125
2 .3571
3 .4167
4 .4348
5 .7143
6 .9000

I have the following six probabilites in a table. Calculating the
total number of combinations 6 choose 3 is easy...=20.

What I want to do is find a simple way to multiply all of the
probabilities together in their groups of three...

An example would be 1x2x3, 1x2x4, 1x2x5, 1x2x6, 2x3x4, 2x3x5 etc until
I've found all 20 answers.

I did a google search but didn't turn up anything for what I'm looking
for.

Thanks
 
Jim,

Below is some code that I modified for you. Put a three into cell A2, then your numbers into A3:A8,
and run the macro MuiltiplyCombinations

HTH,
Bernie
MS Excel MVP


Sub MuiltiplyCombinations()
Dim Rng As Range
Dim PopSize As Integer
Dim SetSize As Integer
Dim Which As String
Dim N As Double
Const BufferSize As Long = 4096
Dim myC As Range

Set Rng = Range("A3:A8")
PopSize = Rng.Cells.Count
SetSize = Range("A2").Value
N = Application.WorksheetFunction.Combin(PopSize, SetSize)
'N will be 20

Application.ScreenUpdating = False

Set Results = Worksheets.Add

vAllItems = Rng.Value
ReDim Buffer(1 To BufferSize) As String
BufferPtr = 0

AddCombination PopSize, SetSize
For Each myC In Results.Cells(1, 1).Resize(N, 1)
myC.Offset(0, 1).Formula = "=" & Replace(myC.Value, ",", "*")
Next myC

Application.ScreenUpdating = True
End Sub


Private Sub AddCombination(Optional PopSize As Integer = 0, _
Optional SetSize As Integer = 0, _
Optional NextMember As Integer = 0, _
Optional NextItem As Integer = 0)

Static iPopSize As Integer
Static iSetSize As Integer
Static SetMembers() As Integer
Dim i As Integer

If PopSize <> 0 Then
iPopSize = PopSize
iSetSize = SetSize
ReDim SetMembers(1 To iSetSize) As Integer
NextMember = 1
NextItem = 1
End If

For i = NextItem To iPopSize
SetMembers(NextMember) = i
If NextMember <> iSetSize Then
AddCombination , , NextMember + 1, i + 1
Else
SavePermutation SetMembers()
End If
Next i

If NextMember = 1 Then
SavePermutation SetMembers(), True
Erase SetMembers
End If

End Sub 'AddCombination


Private Sub SavePermutation(ItemsChosen() As Integer, _
Optional FlushBuffer As Boolean = False)

Dim i As Integer, sValue As String
Static RowNum As Long, ColNum As Long

If RowNum = 0 Then RowNum = 1
If ColNum = 0 Then ColNum = 1

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
If BufferPtr > 0 Then
If (RowNum + BufferPtr - 1) > Rows.Count Then
RowNum = 1
ColNum = ColNum + 1
If ColNum > 256 Then Exit Sub
End If

Results.Cells(RowNum, ColNum).Resize(BufferPtr, 1).Value _
= Application.WorksheetFunction.Transpose(Buffer())
RowNum = RowNum + BufferPtr
End If

BufferPtr = 0
If FlushBuffer = True Then
Erase Buffer
RowNum = 0
ColNum = 0
Exit Sub
Else
ReDim Buffer(1 To UBound(Buffer))
End If

End If

'construct the next set
For i = 1 To UBound(ItemsChosen)
sValue = sValue & ", " & vAllItems(ItemsChosen(i), 1)
Next i

'and save it in the buffer
BufferPtr = BufferPtr + 1
Buffer(BufferPtr) = Mid$(sValue, 3)
End Sub 'SavePermutation
 
Wow! Bernie, thanks a lot.

But I have a problem. I know nothing about macros. All of the
spreadsheets I write don't use macros. But I want to learn.

I tried pasting this code into the compiler (developer>macros>etc.),
but it gives me a compile error.

Sorry for the confusion, but I don't know if I'm even doing it right.

Thanks again for doing all that work.
 
The compile error is:

"sub or function not defined"

The word buffer (after unbound) is highlighted in this line of code:

If FlushBuffer = True Or BufferPtr = UBound(Buffer()) Then
 
Jim,

My apologies! I neglected to copy the declarations from the top of the module - just paste this at
the top of your codemodule.

Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet


HTH,
Bernie
MS Excel MVP
 
Above all other code Bernie posted enter these lines.

Option Explicit

Dim vAllItems As Variant
Dim Buffer() As String
Dim BufferPtr As Long
Dim Results As Worksheet


Gord Dibben MS Excel MVP
 
Thanks, Bernie. I think I got it to work. A question:

If I want to change it to 6 choose 4 do I simply change the 3 to a 4
in this line?

Buffer(BufferPtr) = Mid$(sValue, 3)

And if I want to do, say 7 or 8 in stead of six numbers do I just
change the range in this line?

Set Rng = Range("A3:A8")

Thanks again, appreciate it.
 
Jim,

No, you do not change this line:
Buffer(BufferPtr) = Mid$(sValue, 3)
Click to expand...

To change the population of numbers, change this line

Set Rng = Range("A3:A8")

to reflect the range where you are storing your numbers, so if you wanted to pick from 8 numbers,
use

Set Rng = Range("A3:A10")


To be flexible, change it to

Set Rng = Range(Range("A3"),Range("A3").End(xlDown))

and the code will choose the list that startes in A3, down to the end of the list.

If you want to use 4 instead of 3 at a time, change the value in cell A2.

HTH,
Bernie
MS Excel MVP
 
Got it Bernie, thank you. That's great, just great.

By the way, how long did it take you to learn to write this kind of
code. It looks impossible to me.
 
Jim,

Stick with it - depends on how much you need it, how hard you work at it,
and your programming background. Months to years to decades....

And you really only need to know enough to modify the code that others
(Myrna Larson (?) in this case) kindly posted previously.

;-)

Bernie
 
Back
Top