PDA

View Full Version : Combining cell (nCr- Probability)



nandakumar
03-13-2008, 07:58 AM
Hi,
I am searching a code for combine the cell in a column and display in another column.
I would say combination set of all cell , please look in to the example below which is my requirement. I would need to find probability (Mathematically nCr , I am not sure ).


example:
column1
NUT
BOLT
WASHER

column2
NUT
NUT / BOLT
NUT / WASHER
NUT / BOLT / WASHER

BOLT
BOLT / NUT
BOLT / WASHER
BOLT / NUT / WASHER

WASHER
WASHER / NUT
WASHER / BOLT
WASHER / NUT / BOLT






Thanks in advance.

Bob Phillips
03-13-2008, 09:06 AM
Sub AllCombinations()
Dim mpSize As Long
Dim mpNextRow As Long
Dim mpCarry As String
Dim mpCallTree As Variant
Dim i As Long

mpSize = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To mpSize

mpNextRow = mpNextRow + 1
Cells(mpNextRow, "C").Value = Cells(i, "A").Value

ReDim mpCallTree(1 To 1)
mpCallTree(1) = i
Call RecurseTree(Carry:=Cells(i, "A").Value, _
Bound:=mpSize, _
CallTree:=mpCallTree, _
NextRow:=mpNextRow)
Next i

End Sub

Private Function RecurseTree(ByVal Carry As String, _
ByVal Bound As Long, _
ByVal CallTree As Variant, _
ByRef NextRow As Long) As Long
Dim j As Long

For j = 1 To Bound

If IsError(Application.Match(j, CallTree, 0)) Then

NextRow = NextRow + 1
Cells(NextRow, "C").Value = Carry & " / " & Cells(j, "A").Value

If j <= Bound Then

ReDim Preserve CallTree(1 To UBound(CallTree) + 1)
CallTree(UBound(CallTree)) = j
Call RecurseTree(Carry:=Cells(NextRow, "C").Value, _
Bound:=Bound, _
CallTree:=CallTree, _
NextRow:=NextRow)
End If
End If
Next j
End Function

nandakumar
03-13-2008, 12:38 PM
Sub AllCombinations()
Dim mpSize As Long
Dim mpNextRow As Long
Dim mpCarry As String
Dim mpCallTree As Variant
Dim i As Long

mpSize = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To mpSize

mpNextRow = mpNextRow + 1
Cells(mpNextRow, "C").Value = Cells(i, "A").Value

ReDim mpCallTree(1 To 1)
mpCallTree(1) = i
Call RecurseTree(Carry:=Cells(i, "A").Value, _
Bound:=mpSize, _
CallTree:=mpCallTree, _
NextRow:=mpNextRow)
Next i

End Sub

Private Function RecurseTree(ByVal Carry As String, _
ByVal Bound As Long, _
ByVal CallTree As Variant, _
ByRef NextRow As Long) As Long
Dim j As Long

For j = 1 To Bound

If IsError(Application.Match(j, CallTree, 0)) Then

NextRow = NextRow + 1
Cells(NextRow, "C").Value = Carry & " / " & Cells(j, "A").Value

If j <= Bound Then

ReDim Preserve CallTree(1 To UBound(CallTree) + 1)
CallTree(UBound(CallTree)) = j
Call RecurseTree(Carry:=Cells(NextRow, "C").Value, _
Bound:=Bound, _
CallTree:=CallTree, _
NextRow:=NextRow)
End If
End If
Next j
End Function


hi,
Please tell me how to use it. I am very new to macro

nandakumar
03-13-2008, 12:42 PM
hi,
yes!! I got it ,, thanks a lot