Grouping Like Column in Like Row

kloocat1

New Member
Joined
Aug 23, 2015
Messages
3
Okay so I have quite the conundrum. I'm pulling hierarchical data out of a data system. I'm utilizing Monarch 11 in order to strip out the necessary data that i need. An example of what I'm left with is below.

PROFILE NAMEOption1Option2Option3Option4Option5
BASICACEACESCEZBEZBE
BASICZBEZBEZZEZZFZZF
BASICZZZ
INTERMEDIATEBBECCE
ADVANCEDACEBCVBCVCDEFGE
ADVANCEDREYREYZZEZZEZZZ

<tbody>
</tbody>


Basically it's a profile name that can have various different options with various sub-options. I didn't need the sub-options for what I'm doing with the data so I didn't strip out the sub-options. The number of options that are available to the profile names vary. Since I didn't strip out the sub-options, I'm left with duplicated options (essentially, each duplicated option you see just means that there was more than one sub-option which is why it stripped out the duplicate option). I basically want to copy the data from each like row (profile name) into just one unique profile name row. I then need to have each option to only show up once in each row (taking out the duplicate options within the row). I have over 1400 rows of data that show duplicates on both the rows and the data (as explained above). I need this all consolidated as such so I can throw it into an Access database for easy viewing of what options are available to each profile name. Any assistance with this issue is greatly appreciated!



V/R,

Chad
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Try this:-
Results start "H1"
Code:
[COLOR="Navy"]Sub[/COLOR] MG24Aug39
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Ray [COLOR="Navy"]As[/COLOR] Variant, k [COLOR="Navy"]As[/COLOR] Variant, G [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] a [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 Ray = Range("A1").CurrentRegion
   [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] Rw = 1 To UBound(Ray, 1)
       [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Ray(Rw, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(Rw, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
                Dic(Ray(Rw, 1))(Ray(Rw, Ac)) = Empty
        [COLOR="Navy"]Next[/COLOR] Ac
  [COLOR="Navy"]Next[/COLOR] Rw
   
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
    c = c + 1: a = 0
    Cells(c, "H").Value = k
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] G [COLOR="Navy"]In[/COLOR] Dic(k)
        a = a + 1
        Cells(1, a + 8).Value = "Option " & a
        Cells(c, a + 8).Value = G
    [COLOR="Navy"]Next[/COLOR] G
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
I can't thank you enough! It seems to work. I actually have 9 Columns (including the profile name column), how do I change the code to include the extra columns? Thanks again for the help!
 
Upvote 0
Try this for results on sheet 2 starting "A1"
Code:
[COLOR="Navy"]Sub[/COLOR] MG24Aug50
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Ray [COLOR="Navy"]As[/COLOR] Variant, k [COLOR="Navy"]As[/COLOR] Variant, G [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] a [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 Ray = Range("A1").CurrentRegion
   [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] Rw = 1 To UBound(Ray, 1)
       [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
            [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Ray(Rw, 1)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Ray(Rw, 1)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
                Dic(Ray(Rw, 1))(Ray(Rw, Ac)) = Empty
        [COLOR="Navy"]Next[/COLOR] Ac
  [COLOR="Navy"]Next[/COLOR] Rw
   
ReDim nray(1 To UBound(Ray, 1), 1 To UBound(Ray, 1) * UBound(Ray, 2))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.keys
    c = c + 1: a = 1
    nray(c, 1) = k
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] G [COLOR="Navy"]In[/COLOR] Dic(k)
        a = a + 1
        nray(1, a) = "Option " & a
        nray(c, a) = G
       oMax = Application.Max(oMax, a)
    [COLOR="Navy"]Next[/COLOR] G
[COLOR="Navy"]Next[/COLOR] k
 [COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax)
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
 [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
That worked perfectly! I really appreciate! I tried making sense of the coding to see if I could change the selected area, but it's completely foreign to me.

V/R,
Chad
 
Upvote 0

Forum statistics

Threads
1,224,223
Messages
6,177,260
Members
452,765
Latest member
Erka Gizli

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