Combinations and Common Key

[topherj]

I have found several threads creating all combinations of pairs within a list. I am having trouble with inserting an additional field to consider if the numbers are eligible to be paired.

First column is a list of work orders (many instances). The second column is a list of items issued to that work order. I am trying to create a 2 column solution with every combination of items issued to the same work order.

Work Order	Item
1	a
1	b
1	c
2	d
2	e
2	f

<colgroup><col><col></colgroup><tbody>
</tbody>

Output would look something like this (2 columns or deliminator):

a b
a c
b c
d e
d f
e f


a, b and c were only paired because they shared a common WO. d,e, and f shared a WO also.

Real world application - trying to identify items often issued together (to the same WO) in order to rearrange warehouse to put items closer to each other. The more combinations of a/b the more likely they will be stored together.,

 

[MickG]

Try this for results starting "C1".

[COLOR="Navy"]Sub[/COLOR] MG22Sep09
[COLOR="Navy"]Dim[/COLOR] vElements, lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] vresult [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] rRng [COLOR="Navy"]As[/COLOR] Range, p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
p = 2
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.value, Dn.Offset(, 1)
            [COLOR="Navy"]Else[/COLOR]
                [COLOR="Navy"]Set[/COLOR] .Item(Dn.value) = Union(.Item(Dn.value), Dn.Offset(, 1))
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
        [COLOR="Navy"]Set[/COLOR] rRng = .Item(K)
        vElements = Application.Index(Application.Transpose(rRng), 1, 0)
        ReDim vresult(1 To p)
        Call CombinationsNP(vElements, CInt(p), vresult, lRow, 1, 1)
    [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
 
[COLOR="Navy"]Sub[/COLOR] CombinationsNP(vElements [COLOR="Navy"]As[/COLOR] Variant, p [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] vresult [COLOR="Navy"]As[/COLOR] Variant, lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] iElement [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] iIndex [COLOR="Navy"]As[/COLOR] Integer)
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
 
[COLOR="Navy"]For[/COLOR] i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    [COLOR="Navy"]If[/COLOR] iIndex = p [COLOR="Navy"]Then[/COLOR]
        lRow = lRow + 1
        Range("C" & lRow).Resize(, p) = vresult
    [COLOR="Navy"]Else[/COLOR]
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[topherj]

This worked great. Thank You Mick

 

[MickG]

You're welcome