How to build an exel table with multiple matching

M

_MicheleL_

New Member
Joined
Sep 24, 2014
Messages
6
Dear All,

Thanks for reading my question.

I need to create a summary table starting from this set of data:
- A: Alphanumeric unique codes;
- B: Alphanumeric unique codes;
- C: Alphanumeric unique codes;

The data are organized in a table where for each couple A, B is possible to have multiple C.

I need to create a data view with:
- A as rows;
- B as columns;
- all the corresponding C in the table fields.

Sample data:
Object
Object code
Vendor Code
Car 1
0001
ab1
Plane
0002
ac3
Ship
0003
ad4
Car 2
0004
ab1
Car 3
0005
ab1

<tbody>
</tbody>

Sample required view:
Vendor Codecar
plane
ship
ab1
0001, 0004, 0005
ac3
0002
ad4
0003

<tbody>
</tbody>


Is the same results you could expect from a pivot but with the list of vaues in the cells instead of the counts.

Please let me know if the topic is clear, any help wold be well accepted.

Thanks,

Michele
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Try this code:-
Your Data sheet1, Results in Sheet2
Code: 
[COLOR="Navy"]Sub[/COLOR] MG24Sep44
[COLOR="Navy"]Dim[/COLOR] Rng             [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn              [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic             [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Dic1            [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Nam             [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Q               [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c               [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K               [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
[COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
        [COLOR="Navy"]Set[/COLOR] Dic1 = CreateObject("scripting.dictionary")
            Dic1.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        Nam = Split(Dn.Value, " ")
        [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Nam(0)) [COLOR="Navy"]Then[/COLOR]
            Dic.Add Nam(0), Dic.Count
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, 2)
    [COLOR="Navy"]If[/COLOR] Not Dic1.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic1.Add Dn.Value, Array(Dn.Offset(, -2), Dn.Offset(, -1).Value)
    [COLOR="Navy"]Else[/COLOR]
        Q = Dic1.Item(Dn.Value)
            Q(1) = Q(1) & "," & Dn.Offset(, -1).Value
        Dic1.Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]


c = 1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
  .Range("A1") = "Vendor Code"
  .Range("B1").Resize(, Dic.Count).Value = Dic.keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic1.keys
        c = c + 1
        .Cells(c, 1) = K
       .Cells(c, Dic.Item(Split(Dic1.Item(K)(0).Value, " ")(0)) + 2).NumberFormat = "@"
       .Cells(c, Dic.Item(Split(Dic1.Item(K)(0).Value, " ")(0)) + 2) = Dic1.Item(K)(1)
    [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
MsgBox "R"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick,

Sorry to bother again but i found a small problem. In case teh same vendor code is shared among different objects in the results table instead than being reported within the right column is grouped in the column related to the first occurence.

Object
Object codeVendor Code
Car 1
0001ab1
Plane0001
ac3
Ship0003ad4
Car 2
0004ab1
Car 3
0005
ab1

<tbody>
</tbody>

I retrieve:
Vendor Code
Car
Plane
Ship
ab1
0001, 0004,0005,0001
ac3
ad4
0003

<tbody>
</tbody>
Instead than:
Vendor Code
Car
Plane
Ship
ab1
0001, 0004,0005
ac3
0001
ad4
0003

<tbody>
</tbody>

May you help me on this?

Thanks in advance,
Have a nice week end,

Michele
 
Upvote 0
Hi Mick,

Sorry for the delay; I've had some probems last week.

Please check the issue with the data below:

<tbody></tbody>
Object
Object Code
Vendor Code
CAR1CAR1_001686587201300
CAR2CAR2_000521487201300
CAR3CAR3_002356387201300
CAR4CAR4_002168587201300
CAR1CAR1_001686687201302
CAR2CAR2_000521987201302
CAR4CAR4_002168687201302
SHIP1SHIP1_003734487201302
CAR1CAR1_001687030403020
PLANE1PLANE1_003431630403020
CAR4CAR4_002169030403020
SHIP1SHIP1_003431630403020

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

I thank you in advance for any help u'll give me.

Thanks,
Have a nice evening,

Michele
 
Upvote 0
Hi Mick,

It should be like this:

Vendor CodeCAR1CAR2CAR3CAR4SHIP1PLANE1
87201300CAR1_0016865CAR2_0005214CAR3_0023563CAR4_0021685
87201302CAR1_0016866CAR2_0005219CAR4_0021686SHIP1_0037344
30403020CAR1_0016870CAR4_0021690SHIP1_0034316PLANE1_0034316

<tbody>
</tbody>

Thanks again for your help.

Have a nice day,

Michele
 
Last edited:
Upvote 0
Try this:-
Data sheet1, Results sheet2.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG07Oct06
[COLOR="Navy"]Dim[/COLOR] Rng             [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn              [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic             [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Dic1            [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Nam             [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Q               [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c               [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K               [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
[COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
        [COLOR="Navy"]Set[/COLOR] Dic1 = CreateObject("scripting.dictionary")
            Dic1.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        Nam = IIf(IsNumeric(Right(Dn.Value, 1)), Left(Dn.Value, Len(Dn.Value) - 1), Dn.Value)
        [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Nam) [COLOR="Navy"]Then[/COLOR]
            Dic.Add Nam, Dic.Count
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, 2)
Nam = IIf(IsNumeric(Right(Dn.Offset(, -2).Value, 1)), Left(Dn.Offset(, -2).Value, Len(Dn.Offset(, -2).Value) - 1), Dn.Offset(, -2).Value)
 [COLOR="Navy"]If[/COLOR] Not Dic1.Exists(Dn.Value & Nam) [COLOR="Navy"]Then[/COLOR]
        Dic1.Add Dn.Value & Nam, Array(Nam, Dn.Offset(, -1).Value, Dn.Value)
    [COLOR="Navy"]Else[/COLOR]
        Q = Dic1.Item(Dn.Value & Nam)
            Q(1) = Q(1) & "," & Dn.Offset(, -1).Value
        Dic1.Item(Dn.Value & Nam) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
c = 1
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
  .Range("A1") = "Vendor Code"
  .Range("B1").Resize(, Dic.Count).Value = Dic.keys
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic1.keys
        c = c + 1
        .Cells(c, 1) = Dic1.Item(K)(2)
        .Cells(c, Dic.Item(Dic1.Item(K)(0)) + 2).NumberFormat = "@"
       .Cells(c, Dic.Item(Dic1.Item(K)(0)) + 2) = Dic1.Item(K)(1)
    [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
MsgBox "R"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
COUNTIF to count cells with conditional formatting
Replies
8
Views
330
Peter_SSs
Peter_SSs
earthworm
  • Question
Populate value inside VBA only without using helper excel tables
Replies
3
Views
309
Legacy 143009
L
J
  • Solved
Macro to Copy Cell Adjacent in One Sheet and Paste in Another Sheet
Replies
1
Views
326
mumps
mumps
G
  • Solved
Combobox search dropdown triggering when editing other sheets
2
Replies
10
Views
534
Akuini
Akuini
R
  • Question
how to: If formula with 3 conditions on multiple columns to create a pivot table
Replies
0
Views
733
raul8
R

Forum statistics

Threads
1,214,405
Messages
6,119,323
Members
448,887
Latest member
AirOliver

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