Sorting duplicate data

[sharky12345]

I think this will be a tough one to solve, but maybe one of you guys can prove me wrong!

I need code to sort duplicate data when a button is pressed as follows;

For exmaple, Sheet 1 has columns A, B and C which contains Date, Name and Time. The info is entered by way of a userform but I need a way of picking up the fact that the Name has appeared twice and then 3 times if necessary.

I want the code to copy the data, paste the values to Sheet 2 which will show columns A, B, C, D, and E and show the data as Date 1, Date 2, Name, Time 1 and Time 2 so that a single row of data shows the fact that the name has appeared twice and on what dates and times.

If that's not enough, I then want the code to clear the cells on Sheet 1 that it has just copied, effectively removing the duplicates from Sheet 1 which are now recorded on Sheet 2.

I need it to work this way because Sheet 2 is then used to Mail Merge in Word and if the data is not correct then it won't work.

Is it possible?

 

[MickG]

If you produce sheet 2 as stated , then any individual "Name" could appears in anyone of a number of columns depending on how many duplicates are found. Is that what you want.
In you final lines, it not clear whether you want the whole of sheet (1)cleared or just the duplicates or have the duplicate rows removed.
Mick

 

[sharky12345]

Mick,

Yes - I need the duplicates to be moved to a seperate sheet and then cleared from the original sheet. So I will end up with Sheet 1 containing data which only appears once, and Sheet 2 that contains data that appears more than once, so the duplicates are clearly seperate.

Does this help?

Paul

 

[MickG]

Hi, Thanks for that. Can you also answer the first question as to whether your happy that the the "Name" (Which is the reference for the item) of each duplicate can end up in any column (from 2 on) on sheet (2) depending on how many duplicates are found.
Mick

 

[sharky12345]

Yes that's fine Mick - the main thing which is important is that the dupplicate entries are on 1 row, but in seperate columns, (i.e. Name1 = Column A, Name2 = Column B etc), but it does not matter where in the row they feature.

 

[MickG]

Try this in your data sheet (assumed your data starts "A2").
The results are in sheet (2) starting "A1".
NB:- This is the Only the first code, to Tranfer data to sheet (2)

[COLOR=navy]Sub[/COLOR] MG23Feb09
[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] Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & 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] Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
        n = n + 1
        .Add Dn.value, Array(n, 3)
    Ray(n, 1) = Format(Dn.Offset(, -1), "dd/mm/yyyy"): Ray(n, 2) = Dn: Ray(n, 3) = Format(Dn.Offset(, 1), "hh:mm;ss")
    [COLOR=navy]Else[/COLOR]
            Q = .Item(Dn.value)
            Q(1) = Q(1) + 2
        [COLOR=navy]For[/COLOR] Ac = Q(1) To 1 [COLOR=navy]Step[/COLOR] -1
            [COLOR=navy]If[/COLOR] Ac = Q(1) [COLOR=navy]Then[/COLOR]
                Ray(Q(0), Ac) = Format(Dn.Offset(, 1), "hh:mm:ss")
            [COLOR=navy]ElseIf[/COLOR] Ac = 1 [COLOR=navy]Then[/COLOR]
              Ray(Q(0), Ac) = Format(Dn.Offset(, -1), "dd/mm/yyyy")
            [COLOR=navy]Else[/COLOR]
              Ray(Q(0), Ac) = Ray(Q(0), Ac - 1) '[COLOR=green][B]temp[/B][/COLOR]
            [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] Ac
            oMax = Application.Max(Q(1), oMax)
            .Item(Dn.value) = Q
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
Sheets("sheet2").Range("A1").Resize(.Count, oMax) = Ray
[COLOR=navy]End With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[sharky12345]

Thanks Mick - will try that!