Creating one row of data from multiple duplicates

T

TheBigEasy

New Member
Joined
Nov 10, 2009
Messages
47
I have 5 colmuns and over 16000 rows of data. Column A holds unique ID codes and, as always I get duplicate rows, caused by differing values in column B.

Ex1
<TABLE style="WIDTH: 250pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=334 border=0 x:str><COLGROUP><COL style="WIDTH: 48pt" span=3 width=64><COL style="WIDTH: 53pt; mso-width-source: userset; mso-width-alt: 2596" span=2 width=71><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: yellow" width=64 height=17>ID</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=64 x:str="Name ">Name1 </TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=64>Number1</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 53pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=71>Start1</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 53pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=71>End1</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>CODE1</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">John</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>31</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="1">01/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40482">31/10/2010</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>CODE1</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">Tom</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>23</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="2">02/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40483">01/11/2010</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>CODE1</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">Paul</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>12</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="3">03/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40484">02/11/2010</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>MARK3</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">John</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>31</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="4">04/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40485">03/11/2010</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>MARK3</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">Mike</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>32</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="5">05/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40486">04/11/2010</TD></TR></TBODY></TABLE>

For each unique code, there will NEVER be duplicates in column B (i.e. CODE1 would never have two rows of "John's" etc.

Essentially I would like to end up with;

<TABLE style="WIDTH: 603pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=807 border=0 x:str><COLGROUP><COL style="WIDTH: 39pt; mso-width-source: userset; mso-width-alt: 1901" span=2 width=52><COL style="WIDTH: 44pt; mso-width-source: userset; mso-width-alt: 2157" width=59><COL style="WIDTH: 53pt; mso-width-source: userset; mso-width-alt: 2596" span=2 width=71><COL style="WIDTH: 39pt; mso-width-source: userset; mso-width-alt: 1901" width=52><COL style="WIDTH: 44pt; mso-width-source: userset; mso-width-alt: 2157" width=59><COL style="WIDTH: 53pt; mso-width-source: userset; mso-width-alt: 2596" span=2 width=71><COL style="WIDTH: 36pt; mso-width-source: userset; mso-width-alt: 1755" width=48><COL style="WIDTH: 44pt; mso-width-source: userset; mso-width-alt: 2157" width=59><COL style="WIDTH: 53pt; mso-width-source: userset; mso-width-alt: 2596" span=2 width=71><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 39pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: yellow" width=52 height=17>ID</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 39pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=52 x:str="Name1 ">Name1 </TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 44pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=59>Number1</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 53pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=71>Start1</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 53pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=71>End1</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 39pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=52 x:str="Name2 ">Name2 </TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 44pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=59>Number2</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 53pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=71>Start2</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 53pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=71>End2</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 36pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=48>Name3</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 44pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=59>Number3</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 53pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=71>Start3</TD><TD class=xl24 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 53pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: yellow" width=71>End3</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>CODE1</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">John</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>31</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="1">01/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40482">31/10/2010</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">Tom</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>23</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="2">02/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40483">01/11/2010</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">Paul</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>12</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="3">03/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40484">02/11/2010</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>MARK3</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">John</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>31</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="4">04/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40485">03/11/2010</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent">Mike</TD><TD class=xl25 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num>32</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="5">05/01/1900</TD><TD class=xl26 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent" x:num="40486">04/11/2010</TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD></TR></TBODY></TABLE>

Any ideas, VBA or otherwise?
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
For an ID will you ever have blank rows?

I have a similar problem with my spreadsheet and need help urgently
 
Upvote 0
Hi, Try this , Results Start "F1". You can place them where you like by altering the range at the bottom of the code.
Code: 
[COLOR=navy]Sub[/COLOR] MG27Jan08
[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] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Q, col [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To Columns.Count)
        [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] Dn.Value <> "" [COLOR=navy]Then[/COLOR]
        [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
            n = n + 1
            .Add Dn.Value, Array(n, 5)
                [COLOR=navy]For[/COLOR] Ac = 0 To 4
                    ray(n, Ac + 1) = Dn.Offset(, Ac)
                [COLOR=navy]Next[/COLOR] Ac
        [COLOR=navy]Else[/COLOR]
            Q = .Item(Dn.Value)
                [COLOR=navy]For[/COLOR] Ac = 0 To 4
                    Q(1) = Q(1) + 1
                    ray(1, Q(1)) = ray(1, Ac + 1)
                    ray(Q(0), Q(1)) = Dn.Offset(, Ac)
                [COLOR=navy]Next[/COLOR] Ac
                    col = Application.Max(Q(1), col)
                    .Item(Dn.Value) = Q
        [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR]
Range("F1").Resize(.Count, col) = ray
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
It's a Pleasure, "Glad it worked"
Mick
Click to expand...

Hi MickG. I have been using this for 4 years and is a brilliant tool and have used it in much of my work. I do have an issue when using more than 1500 lines of data when I get an "Out of Memory" error.

Is there any way to avoid this?
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG28Jan12
[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] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] t
t = Timer
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 5)
    col = UBound(ray, 2)
        [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] Dn.Value <> "" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
            n = n + 1
            .Add Dn.Value, Array(n, 5)
                [COLOR="Navy"]For[/COLOR] Ac = 0 To 4
                    ray(n, Ac + 1) = Dn.Offset(, Ac)
                [COLOR="Navy"]Next[/COLOR] Ac
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(Dn.Value)
                 [COLOR="Navy"]If[/COLOR] Q(1) <= col [COLOR="Navy"]Then[/COLOR]
                    ReDim Preserve ray(1 To Rng.Count, 1 To col + 5)
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]For[/COLOR] Ac = 0 To 4
                   Q(1) = Q(1) + 1
                   ray(1, Q(1)) = ray(1, Ac + 1)
                    ray(Q(0), Q(1)) = Dn.Offset(, Ac)
                [COLOR="Navy"]Next[/COLOR] Ac
                    
                    col = Application.Max(Q(1), col)
                    
                    .Item(Dn.Value) = Q
       
        [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]
Range("F1").Resize(.Count, col) = ray
[COLOR="Navy"]End[/COLOR] With
MsgBox Timer - t
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Mick this is excellent and will make a difference to a lot of my work.

I had amended the original one that you provided slightly to allow the VBA to work with any number of columns as below (bold showing the amendements):
Code: 
Sub OneLinex()
Dim Rng As Range, Dn As Range, n As Long, Ac As Integer
Dim Q, col As Integer
[U][B]Dim LastCol As Integer[/B]
[/U]LastCol = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To [U][B]Columns.Count[/B][/U])
        With CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
    For Each Dn In Rng
        If Dn.Value <> "" Then
        If Not .Exists(Dn.Value) Then
            n = n + 1
            .Add Dn.Value, Array(n, [U][B]LastCol + 2[/B][/U])
                For Ac = 0 To [U][B]LastCol + 1
[/B][/U]                   ray(n, Ac + 1) = Dn.Offset(, Ac)
                Next Ac
        Else
            Q = .Item(Dn.Value)
                For Ac = 0 To[B] [U]LastCol + 1
[/U][/B]                   Q(1) = Q(1) + 1
                    ray(1, Q(1)) = ray(1, Ac + 1)
                    ray(Q(0), Q(1)) = Dn.Offset(, Ac)
                Next Ac
                    col = Application.Max(Q(1), col)
                    .Item(Dn.Value) = Q
        End If
        End If
    Next
[U][B]Range(Columns(LastCol + 3).Rows(1), Columns(LastCol + 3).Rows(1)).Resize(.Count, col) = ray
[/B][/U]End With
End Sub

With my basic knowledge I have tried to apply this with your new code but keep getting an error - can you help?
 
Upvote 0
I think you would be better of using my latest code this caters for an initial number of columns in your basic data of 5. which you could change to your "LastCol" variable.
When the code finds duplicate lines it adds Extra columns to the final Array, Using the "Redim Preserve" statement, so it takes care any extra columns required, and should stop the "Out of memory" error.
If you are able to post an alternative set of data with more columns and the expected result.
This will give me a better understanding of what extra columns means in terms of your data.
I'll will alter the code to cater for both (and/or variable number of columns) sets.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
G
  • Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
854
gvsumich
G
E
  • Question
VBA for Web Scraping help
Replies
0
Views
606
epactheactor
E
E
  • Question
Query in excel to Outlook mail take rows with name until next name
Replies
0
Views
357
esben
E
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C

Forum statistics

Threads
1,215,517
Messages
6,125,290
Members
449,218
Latest member
Excel Master

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