Breakdown data in groups by relation

R

Razr

New Member
Joined
Jan 13, 2009
Messages
35
Hello everybody,

I have a quite large data sets (70.000) and would like your help.

Data sets looks as follows:


COL1
(orderid)		COL2 (prod.id)
group1230
group1501
group21231
group2501
group22141
group25151
group251591
group2212312
group3230
group325151
group324515
group35122591
group42255
group4501
group525151
group555
group51241
group5151
group551521
group525252

<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>
</tbody>
....... .........

What I want to do is regroup these groups based on relation.

For example 230 exists in Group 1 & Group 3
So we have one group there which consists of all which means

230,501,230,25151,24515,5122591.

But then 501 also coexists in group 4 so our group gets bigger we need to add also 2255 to our set

230,501,230,25151,24515,5122591,2255

But then 2255 also exists in group *** so we need to add *** since it coexists with 2255

So basically I need to make a group breakdown of all products that exist in same orderids.

In other words I need to group data by relation.
In a more "logical" language imagine this as "related products" group breakdown (where the criteria is that they coexist in any give orderid).

I hope this is clear.

Thank you in advance
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
Try this for Results starting "D1".
Code: 
[COLOR="Navy"]Sub[/COLOR] MG26Mar44
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Dic2 [COLOR="Navy"]As[/COLOR] Object, Dic3 [COLOR="Navy"]As[/COLOR] Object
[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"]Set[/COLOR] Rng = Range("b2", Range("b" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Dn.Value, Dn.Offset(, -1).Value
    [COLOR="Navy"]Else[/COLOR]
        Dic(Dn.Value) = Dic(Dn.Value) & ", " & Dn.Offset(, -1).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic2 = CreateObject("scripting.dictionary")
Dic2.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dic2.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic2.Add Dn.Value, Dn.Offset(, 1).Value
    [COLOR="Navy"]Else[/COLOR]
        Dic2(Dn.Value) = Dic2(Dn.Value) & ", " & Dn.Offset(, 1).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant, nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Dic3 = CreateObject("scripting.dictionary")
Dic3.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dic.items
    Sp = Split(R, ", ")
    nStr = ""
        [COLOR="Navy"]For[/COLOR] N = 0 To UBound(Sp)
            nStr = nStr & IIf(nStr = "", Dic2(Sp(N)), ", " & Dic2(Sp(N)))
        [COLOR="Navy"]Next[/COLOR] N
        [COLOR="Navy"]If[/COLOR] Not Dic3.Exists(R) [COLOR="Navy"]Then[/COLOR]
            Dic3.Add R, nStr
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]With[/COLOR] Range("D1").Resize(Dic3.Count, 2)
    .Value = Application.Transpose(Array(Dic3.Keys, Dic3.items))
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this for Results starting "D1".
Code: 
[COLOR=Navy]Sub[/COLOR] MG26Mar44
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object, Dic2 [COLOR=Navy]As[/COLOR] Object, Dic3 [COLOR=Navy]As[/COLOR] Object
[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]Set[/COLOR] Rng = Range("b2", Range("b" & Rows.Count).End(xlUp))
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
        Dic.Add Dn.Value, Dn.Offset(, -1).Value
    [COLOR=Navy]Else[/COLOR]
        Dic(Dn.Value) = Dic(Dn.Value) & ", " & Dn.Offset(, -1).Value
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]Set[/COLOR] Dic2 = CreateObject("scripting.dictionary")
Dic2.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not Dic2.Exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
        Dic2.Add Dn.Value, Dn.Offset(, 1).Value
    [COLOR=Navy]Else[/COLOR]
        Dic2(Dn.Value) = Dic2(Dn.Value) & ", " & Dn.Offset(, 1).Value
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]Dim[/COLOR] R [COLOR=Navy]As[/COLOR] Variant, Sp [COLOR=Navy]As[/COLOR] Variant, nStr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Set[/COLOR] Dic3 = CreateObject("scripting.dictionary")
Dic3.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] R [COLOR=Navy]In[/COLOR] Dic.items
    Sp = Split(R, ", ")
    nStr = ""
        [COLOR=Navy]For[/COLOR] N = 0 To UBound(Sp)
            nStr = nStr & IIf(nStr = "", Dic2(Sp(N)), ", " & Dic2(Sp(N)))
        [COLOR=Navy]Next[/COLOR] N
        [COLOR=Navy]If[/COLOR] Not Dic3.Exists(R) [COLOR=Navy]Then[/COLOR]
            Dic3.Add R, nStr
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] R
[COLOR=Navy]With[/COLOR] Range("D1").Resize(Dic3.Count, 2)
    .Value = Application.Transpose(Array(Dic3.Keys, Dic3.items))
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

Thank you MickG.

Is there any way to get unique values in the results?

I am getting repetitive values in the comma separated results in the prodid result (column E). For example 5122591,5122591

Moreover I am getting same prodID in many rows results I need in one row unique prodIds.
 
Upvote 0
There is no problem getting Unique "prodID" number per row, but as each set of "prodID" number relates to related groups, it seems inevitable that there will be duplicates across all groups.
With that in mind , and the results below what would you like to see as you actual Results.???

group1, group3
230, 501, 230, 25151, 24515, 5122591
group1, group2, group4
230, 501, 1231, 501, 2141, 5151, 51591, 212312, 2255, 501
group2
1231, 501, 2141, 5151, 51591, 212312
group3, group5
230, 25151, 24515, 5122591, 25151, 55, 1241, 151, 51521, 25252
group3
230, 25151, 24515, 5122591
group4
2255, 501
group5
25151, 55, 1241, 151, 51521, 25252

<tbody>
</tbody>
 
Last edited:
Upvote 0
MickG said:
There is no problem getting Unique "prodID" number per row, but as each set of "prodID" number relates to related groups, it seems inevitable that there will be duplicates across all groups.
With that in mind , and the results below what would you like to see as you actual Results.???

group1, group3230, 501, 230, 25151, 24515, 5122591
group1, group2, group4230, 501, 1231, 501, 2141, 5151, 51591, 212312, 2255, 501
group21231, 501, 2141, 5151, 51591, 212312
group3, group5230, 25151, 24515, 5122591, 25151, 55, 1241, 151, 51521, 25252
group3230, 25151, 24515, 5122591
group42255, 501
group525151, 55, 1241, 151, 51521, 25252

<tbody>
</tbody>
Click to expand...

Yep that's exactly what i need as actual results
 
Upvote 0
Try this:-
Result start "D1"

Code: 
[COLOR=navy]Sub[/COLOR] MG27Mar41
[COLOR=navy]Dim[/COLOR] Dic [COLOR=navy]As[/COLOR] Object, Dic2 [COLOR=navy]As[/COLOR] Object, Dic3 [COLOR=navy]As[/COLOR] Object
[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]Set[/COLOR] Rng = Range("b2", Range("b" & Rows.Count).End(xlUp))
[COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        Dic.Add Dn.Value, Dn.Offset(, -1).Value
    [COLOR=navy]Else[/COLOR]
        Dic(Dn.Value) = Dic(Dn.Value) & ", " & Dn.Offset(, -1).Value
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]Set[/COLOR] Dic2 = CreateObject("scripting.dictionary")
Dic2.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not Dic2.Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        Dic2.Add Dn.Value, Dn.Offset(, 1).Value
    [COLOR=navy]Else[/COLOR]
        Dic2(Dn.Value) = Dic2(Dn.Value) & ", " & Dn.Offset(, 1).Value
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Dim[/COLOR] R [COLOR=navy]As[/COLOR] Variant, Sp [COLOR=navy]As[/COLOR] Variant, nStr [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Set[/COLOR] Dic3 = CreateObject("scripting.dictionary")
Dic3.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Dic.items
    Sp = Split(R, ", ")
    nStr = ""
        [COLOR=navy]For[/COLOR] n = 0 To UBound(Sp)
            nStr = nStr & IIf(nStr = "", Dic2(Sp(n)), ", " & Dic2(Sp(n)))
        [COLOR=navy]Next[/COLOR] n
        [COLOR=navy]If[/COLOR] Not Dic3.Exists(R) [COLOR=navy]Then[/COLOR]
            Dic3.Add R, nStr
        [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] R
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] Dic3.keys
    Sp = Split(Dic3(K), ", ")
    nStr = ""
        [COLOR=navy]For[/COLOR] n = 0 To UBound(Sp)
            [COLOR=navy]If[/COLOR] InStr(nStr, Sp(n)) = 0 [COLOR=navy]Then[/COLOR]
                nStr = nStr & IIf(nStr = "", Sp(n), ", " & Sp(n))
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] n
        Dic3(K) = nStr
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]With[/COLOR] Range("D1").Resize(Dic3.Count, 2)
    .Value = Application.Transpose(Array(Dic3.keys, Dic3.items))
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
data layout
2
Replies
13
Views
1K
Fluff
Fluff
D
  • Question
Delete all associated variables in a listbox items with same value
Replies
0
Views
469
devofish
D
M
  • Question
How To Separate Data In 5 Groups
2 3
Replies
25
Views
2K
motilulla
M

Forum statistics

Threads
1,216,182
Messages
6,129,369
Members
449,506
Latest member
nomvula

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top