Remove duplicates in multiple columns and return the names in one column horizontally

B

brandnewbie

New Member
Joined
Jul 21, 2012
Messages
6
Hi,

I don't have the Excel skills or knowledge to even attempt this so it will be easier to show the before and after of what I'm trying to achieve. I desperately need to change this source data:

[TABLE="class: grid, width: 700, align: center"]
<tbody>[TR]
[TD]User Name[/TD]
[TD]Entity Code[/TD]
[TD]Business Area[/TD]
[TD]Level 1[/TD]
[TD]Level 2[/TD]
[TD]Level 3[/TD]
[TD]Level 4[/TD]
[/TR]
[TR]
[TD]Howard Ratner[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Cheryl Williams[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Howard Ratner[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be defined[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Roger Hirst[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Gerald Richards[/TD]
[TD]26.3.1117[/TD]
[TD]HR[/TD]
[TD]y[/TD]
[TD]y[/TD]
[TD]y[/TD]
[TD]y[/TD]
[/TR]
</tbody>[/TABLE]


...into this if possible:

[TABLE="class: grid, width: 700, align: center"]
<tbody>[TR]
[TD]Entity Code[/TD]
[TD]Business Area[/TD]
[TD]Level 1[/TD]
[TD]Level 2[/TD]
[TD]Level 3[/TD]
[TD]Level 4[/TD]
[/TR]
[TR]
[TD]98.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD]Nick Kemp[/TD]
[TD]Nick Kemp[/TD]
[TD]Howard Ratner[/TD]
[TD]Cheryl Williams[/TD]
[/TR]
[TR]
[TD]97.1.3456[/TD]
[TD]Web Hosting[/TD]
[TD]Roger Hirst[/TD]
[TD]To be defined[/TD]
[TD]Howard Ratner[/TD]
[TD]Nick Kemp[/TD]
[/TR]
[TR]
[TD]26.3.1117[/TD]
[TD]HR[/TD]
[TD]Gerald Richards[/TD]
[TD]Gerald Richards[/TD]
[TD]Gerald Richards[/TD]
[TD]Gerald Richards[/TD]
[/TR]
</tbody>[/TABLE]

Any help would be GREATLY appreciated. Thank you!!!!
 
Sort by date Sort by votes
Try this:-
Results sheet(2)
Code: 
[COLOR="Navy"]Sub[/COLOR] MG21Jul07
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Col         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c            [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 6)
        [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]
        n = n + 1
        .Add Dn.Value, n
            [COLOR="Navy"]For[/COLOR] Col = 1 To 6
                ray(n, Col) = IIf(UCase(Dn(, Col)) = "Y", Dn.Offset(, -1), Dn(, Col))
            [COLOR="Navy"]Next[/COLOR] Col
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]For[/COLOR] Col = 3 To 6
            [COLOR="Navy"]If[/COLOR] UCase(Dn(, Col)) = "Y" [COLOR="Navy"]Then[/COLOR] ray(.Item(Dn.Value), Col) = Dn.Offset(, -1)
         [COLOR="Navy"]Next[/COLOR] Col
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
c = .Count
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("sheet2")
    .Range("A1").Resize(c, 6) = ray
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Wow! I had no idea it would be that complex. Thank you so much for the speedy response but I fear I will never be able to understand or modify that! Is there anyway of doing this without using code, even if it's multiple crude steps?
 
Upvote 0
Hi Mick,

Thanks again for your solution. Looks like I'm stuck with using code to resolve this.

In running the code you've kindly provided, I've picked up on some other issues with the data set which I hope you might be able to help with. Basically, the Entity Code is not a unique identifier for Business Area and may have a one to many relationship. I have pasted a revised version of the table in the hope that a slight amendment to the code can accommodate this? Many thanks again for your help!

[TABLE="class: cms_table_grid, width: 700, align: center"]
<tbody>[TR]
[TD]User Name[/TD]
[TD]Entity Code[/TD]
[TD]Business Area[/TD]
[TD]Level 1[/TD]
[TD]Level 2[/TD]
[TD]Level 3[/TD]
[TD]Level 4[/TD]
[/TR]
[TR]
[TD]Howard Ratner[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting 2[/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Cheryl Williams[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Howard Ratner[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be defined[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Roger Hirst[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Gerald Richards[/TD]
[TD]26.3.1117[/TD]
[TD]HR[/TD]
[TD]y[/TD]
[TD]y[/TD]
[TD]y[/TD]
[TD]y[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
MickG said:
Try this:-
Results sheet(2)
Code: 
[COLOR=Navy]Sub[/COLOR] MG21Jul07
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Col         [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] c            [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 6)
        [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]
        n = n + 1
        .Add Dn.Value, n
            [COLOR=Navy]For[/COLOR] Col = 1 To 6
                ray(n, Col) = IIf(UCase(Dn(, Col)) = "Y", Dn.Offset(, -1), Dn(, Col))
            [COLOR=Navy]Next[/COLOR] Col
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]For[/COLOR] Col = 3 To 6
            [COLOR=Navy]If[/COLOR] UCase(Dn(, Col)) = "Y" [COLOR=Navy]Then[/COLOR] ray(.Item(Dn.Value), Col) = Dn.Offset(, -1)
         [COLOR=Navy]Next[/COLOR] Col
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
c = .Count
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]With[/COLOR] Sheets("sheet2")
    .Range("A1").Resize(c, 6) = ray
    .Columns.AutoFit
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

Hi Mick,

Thanks again for your solution. Looks like I'm stuck with using code to resolve this.

In running the code you've kindly provided, I've picked up on some other issues with the data set which I hope you might be able to help with. Basically, the Entity Code is not a unique identifier for Business Area and may have a one to many relationship. I have pasted a revised version of the table in the hope that a slight amendment to the code can accommodate this? Many thanks again for your help!

[TABLE="class: cms_table_cms_table_grid, width: 700, align: center"]
<tbody>[TR]
[TD]User Name[/TD]
[TD]Entity Code[/TD]
[TD]Business Area[/TD]
[TD]Level 1[/TD]
[TD]Level 2[/TD]
[TD]Level 3[/TD]
[TD]Level 4[/TD]
[/TR]
[TR]
[TD]Howard Ratner[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting 2[/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Cheryl Williams[/TD]
[TD]98.1.3456[/TD]
[TD]Web Hosting 2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Howard Ratner[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be defined[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Roger Hirst[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD]Y[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Nick Kemp[/TD]
[TD]97.1.3456[/TD]
[TD]Web Hosting 1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]Gerald Richards[/TD]
[TD]26.3.1117[/TD]
[TD]HR[/TD]
[TD]y[/TD]
[TD]y[/TD]
[TD]y[/TD]
[TD]y[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
If this is not the solution, please post the expected results as well as the basic data.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG22Jul34
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Col         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Twn         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 6)
        [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Twn = Dn & Dn.Offset(, 1)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Twn) [COLOR="Navy"]Then[/COLOR]
        n = n + 1
        .Add Twn, n
            [COLOR="Navy"]For[/COLOR] Col = 1 To 6
                ray(n, Col) = IIf(UCase(Dn(, Col)) = "Y", Dn.Offset(, -1), Dn(, Col))
            [COLOR="Navy"]Next[/COLOR] Col
    [COLOR="Navy"]Else[/COLOR]
        [COLOR="Navy"]For[/COLOR] Col = 3 To 6
            [COLOR="Navy"]If[/COLOR] UCase(Dn(, Col)) = "Y" [COLOR="Navy"]Then[/COLOR] ray(.Item(Twn), Col) = Dn.Offset(, -1)
         [COLOR="Navy"]Next[/COLOR] Col
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
c = .Count
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("sheet2")
    .Range("A1").Resize(c, 6) = ray
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
If this is not the solution, please post the expected results as well as the basic data.
Code: 
[COLOR=Navy]Sub[/COLOR] MG22Jul34
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Col         [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] c           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Twn         [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 6)
        [COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    Twn = Dn & Dn.Offset(, 1)
    [COLOR=Navy]If[/COLOR] Not .Exists(Twn) [COLOR=Navy]Then[/COLOR]
        n = n + 1
        .Add Twn, n
            [COLOR=Navy]For[/COLOR] Col = 1 To 6
                ray(n, Col) = IIf(UCase(Dn(, Col)) = "Y", Dn.Offset(, -1), Dn(, Col))
            [COLOR=Navy]Next[/COLOR] Col
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]For[/COLOR] Col = 3 To 6
            [COLOR=Navy]If[/COLOR] UCase(Dn(, Col)) = "Y" [COLOR=Navy]Then[/COLOR] ray(.Item(Twn), Col) = Dn.Offset(, -1)
         [COLOR=Navy]Next[/COLOR] Col
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
c = .Count
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]With[/COLOR] Sheets("sheet2")
    .Range("A1").Resize(c, 6) = ray
    .Columns.AutoFit
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

This seems to have done the trick!!! Still testing the results but, thank you so much regardless, you've saved my bacon!!
 
Upvote 0
MickG said:
Your welcome
Mick
Click to expand...

Hi there,

Further testing (admittedly of my slightly tweaked version of the code to cater for the extra column to be returned and condition to be met?) has showed up some odd results. I simply don't know any VBA so probably best leave it to the pros. I've dumped an extract of the real data here in the hope that captures all eventualities and that someone will be able to help. Sorry to keep this query going on - I probably should have done this from the outset!

So the following source data:

[TABLE="width: 1075"]
<tbody>[TR]
[TD]User Name
[/TD]
[TD]Entity
[/TD]
[TD]Entity Description
[/TD]
[TD]Account Description
[/TD]
[TD]Level 1
[/TD]
[TD]Level 2
[/TD]
[TD]Level 3
[/TD]
[TD]Level 4
[/TD]
[/TR]
[TR]
[TD]David Hoole
[/TD]
[TD]To be confirmed
[/TD]
[TD]All
[/TD]
[TD]Advertising Promotion
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Sara Girard
[/TD]
[TD]To be confirmed
[/TD]
[TD]All
[/TD]
[TD]Advertising Promotion
[/TD]
[TD]Y
[/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]David Hoole
[/TD]
[TD]To be confirmed
[/TD]
[TD]All
[/TD]
[TD]Advertising Promotion
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Mike Florek
[/TD]
[TD]To be confirmed
[/TD]
[TD]AM US
[/TD]
[TD]Advertising Promotion
[/TD]
[TD][/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Michael Voss
[/TD]
[TD]To be confirmed
[/TD]
[TD]AM US
[/TD]
[TD]Advertising Promotion
[/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Gerrard Preston
[/TD]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints
[/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Andy Douglas
[/TD]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints
[/TD]
[TD][/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Dean Sanderson
[/TD]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Jessica Rutt
[/TD]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints – Rightslink
[/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]David Hoole
[/TD]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints – Rightslink
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Debashish Brahmachari
[/TD]
[TD]To be confirmed
[/TD]
[TD]ABC India
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Tony Bocquet
[/TD]
[TD]To be confirmed
[/TD]
[TD]ABC Asia
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Javier Cazana
[/TD]
[TD]To be confirmed
[/TD]
[TD]ABC Brazil & ABC Ibero
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Y
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]David Swinbanks
[/TD]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



Should result in this:
[TABLE="width: 891"]
<tbody>[TR]
[TD]Entity
[/TD]
[TD]Entity Description
[/TD]
[TD]Account Description
[/TD]
[TD]Level 1
[/TD]
[TD]Level 2
[/TD]
[TD]Level 3
[/TD]
[TD]Level 4
[/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]All
[/TD]
[TD]Advertising Promotion
[/TD]
[TD]Sara Girard
[/TD]
[TD]Sara Girard
[/TD]
[TD]David Hoole
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]AM US
[/TD]
[TD]Advertising Promotion
[/TD]
[TD]Michael Voss
[/TD]
[TD]Mike Florek
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints
[/TD]
[TD]Gerrard Preston
[/TD]
[TD]Andy Douglas
[/TD]
[TD]Dean Sanderson
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints – Rightslink
[/TD]
[TD]Jessica Rutt
[/TD]
[TD][/TD]
[TD]David Hoole
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]ABC India
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Debashish Brahmachari
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]ABC Asia
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Tony Bocquet
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]ABC Brazil & ABC Ibero
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Javier Cazana
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD][/TD]
[TD][/TD]
[TD]David Swinbanks
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


However, having tried to 'amend' the code as follows:

Sub brandnewbie()
Dim Rng As Range
Dim Dn As Range
Dim n As Long
Dim Col As Integer
Dim c As Long
Dim Twn As String
Set Rng = Range(Range("B1"), Range("B" & Rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count, 1 To 7)
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
Twn = Dn & Dn.Offset(, 1)
If Not .Exists(Twn) Then
n = n + 1
.Add Twn, n
For Col = 1 To 7
ray(n, Col) = IIf(UCase(Dn(, Col)) = "Y", Dn.Offset(, -1), Dn(, Col))
Next Col
Else
For Col = 4 To 7
If UCase(Dn(, Col)) = "Y" Then ray(.Item(Twn), Col) = Dn.Offset(, -1)
Next Col
End If
Next
c = .Count
End With
With Sheets("macro results")
.Range("A1").Resize(c, 7) = ray
.Columns.AutoFit
End With
End Sub


I am getting this:
[TABLE="width: 891"]
<tbody>[TR]
[TD]Entity
[/TD]
[TD]Entity Description
[/TD]
[TD]Account Description
[/TD]
[TD]Level 1
[/TD]
[TD]Level 2
[/TD]
[TD]Level 3
[/TD]
[TD]Level 4
[/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]All
[/TD]
[TD]Advertising Promotion
[/TD]
[TD]Sara Girard
[/TD]
[TD]Sara Girard
[/TD]
[TD]David Hoole
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]All
[/TD]
[TD]Advertising Promotion
[/TD]
[TD][/TD]
[TD][/TD]
[TD]David Hoole
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]AM US
[/TD]
[TD]Advertising Promotion
[/TD]
[TD]Michael Voss
[/TD]
[TD]Mike Florek
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]All Titles
[/TD]
[TD]Commercial Reprints
[/TD]
[TD]Jessica Rutt
[/TD]
[TD]Andy Douglas
[/TD]
[TD]David Swinbanks
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]ABC India
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Debashish Brahmachari
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]ABC Asia
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Tony Bocquet
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]To be confirmed
[/TD]
[TD]ABC Brazil & ABC Ibero
[/TD]
[TD]Commercial Reprints – ABC
[/TD]
[TD]Javier Cazana
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Thanks a lot again for any help anyone can give!!!
 
Upvote 0
Try this:-
I think I been looking at the wrong Column !!!
Code: 
[COLOR="Navy"]Sub[/COLOR] MG25Jul17
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Col         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Twn         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B1"), Range("B" & Rows.count).End(xlUp))
    ReDim ray(1 To Rng.count, 1 To 7)
        [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            Twn = Dn.Offset(, 1) & Dn.Offset(, 2)
                [COLOR="Navy"]If[/COLOR] Not .Exists(Twn) [COLOR="Navy"]Then[/COLOR]
                    n = n + 1
                .Add Twn, n
                    [COLOR="Navy"]For[/COLOR] Col = 1 To 7
                        ray(n, Col) = IIf(UCase(Dn(, Col)) = "Y", Dn.Offset(, -1), Dn(, Col))
                     [COLOR="Navy"]Next[/COLOR] Col
                [COLOR="Navy"]Else[/COLOR]
                    [COLOR="Navy"]For[/COLOR] Col = 4 To 7
                        [COLOR="Navy"]If[/COLOR] UCase(Dn(, Col)) = "Y" [COLOR="Navy"]Then[/COLOR] ray(.Item(Twn), Col) = Dn.Offset(, -1)
                    [COLOR="Navy"]Next[/COLOR] Col
                [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR]
c = .count
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Macro_Results")
    .Range("A1").Resize(c, 7) = ray
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
You must log in or register to reply here.

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