Converting multiple rows to single rows

cassin

New Member
Joined
Sep 19, 2006
Messages
4
I have a file with this structure:

User1, date
User1, date
User1, date
User2, date
User3, date
User3, date ...

In other words, a list of people with dates against them. Each person may have 1-24 dates and this is currently appearing as multiple rows.

I'm trying to get to the following structure:

User1, date, date, date
User2, date
User3, date, date ...

That is, one line per user, with all recorded dates on the same line.

Any suggestions appreciated.

Thanks.
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
The answer I gave in this thread appears to be literally exactly what you need, too.

http://www.mrexcel.com/forum/showthread.php?t=367946#5

That uses two formulas to create the unique list of IDs in one column, then the JoinAll function from Jindon to create the dates in the next column, separated by commas.

Excel Workbook
ABCDE
1User11/1/2009User11/1/2009, 1/2/2009, 1/3/2009
2User11/2/2009User21/4/2009, 1/5/2009, 1/6/2009
3User11/3/2009User31/7/2009, 1/8/2009
4User21/4/2009
5User21/5/2009
6User21/6/2009
7User31/7/2009
8User31/8/2009
Sheet3
 
Last edited:
Upvote 0
Assuming your list of User, date is in Column A, you could put a list of user names in Column B and then run something like the following:

Code:
Dim iCTR As Integer
    For iCTR = 1 To 10
        Select Case Split(Range("A" & iCTR).Value, ",")(0)
            Case "User1"
                Range("B1").Value = Range("B1").Value & ", " & Split(Range("A" & iCTR).Value, ",")(1)
            Case "User2"
                Range("B2").Value = Range("B2").Value & ", " & Split(Range("A" & iCTR).Value, ",")(1)
            Case "User3"
                Range("B3").Value = Range("B3").Value & ", " & Split(Range("A" & iCTR).Value, ",")(1)
        End Select
    Next iCTR
 
Upvote 0
Hi, Try this:-
Names in column "A" , Dates Column "B"
Code:
Dim cl As Range, oNm, Rng As Range, Mch, Ray
Dim Nray(), c As Integer, Rw As Integer
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
Ray = Rng
c = 0
For Each cl In Rng
    Rw = cl.Row
        For Mch = (UBound(Ray) + 1) To 1 Step -1
            If Range("B" & Mch).Row >= cl.Row _
                And cl.Offset(, -1).Value = Range _
                ("A" & Mch).Value Then
                ReDim Preserve Nray(c)
                Nray(c) = Format(Range("B" & Mch).Value, "dd/mm/yy")
                c = c + 1
                If Rw < Mch Then Range("B" & Mch).EntireRow.Delete
            End If
       Next Mch
       cl.Resize(, c).Value = Nray
    
Erase Nray
c = 0
Next cl
Regards Mick
 
Upvote 0
Hi,

Code:
Sub kTest()
Dim a, k(), q(), i As Long, n As Long, lCol As Long
a = Range("a1").CurrentRegion.Resize(, 2)
ReDim k(1 To UBound(a, 1), 1 To Columns.Count)
With CreateObject("scripting.dictionary")
    .comparemode = vbTextCompare
    For i = 1 To UBound(a, 1)
        If Not .exists(a(i, 1)) Then
            n = n + 1
            k(n, 1) = a(i, 1): k(n, 2) = a(i, 2)
            .Add a(i, 1), Array(n, 2)
        Else
            q = .Item(a(i, 1)): q(1) = q(1) + 1
            k(q(0), q(1)) = a(i, 2)
            lCol = Application.Max(lCol, q(1))
            .Item(a(i, 1)) = q
        End If
    Next
End With
With Range("d1")
    .Resize(n, lCol).Value = k
End With
End Sub

HTH
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

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