getting data from columns to rows without using transpose

**rachbendy** · 03-26-2009, 06:08 AM

Hi, I have an excel spreadsheet which contains data for customers and the last date they were seen at an appointment (along with various other bits of info). The way the data is exported from my database package means that each customer has one row per appointment, i.e. row 1 contains john smith, 01/01/2009, row 2 contains john smith, 03/03/2009, row 3 contains john smith 01/04/2009, row 4 contains joe bloggs 12/02/2009, row 5 contains joe bloggs 27/03/2009. Some customers may have 4 or 5 appointments listed whereas another customer may only have one. I need to get the appointments all onto one row per customer so that I can calculate the number of days between appointments. I have tried to use transpose, but with 8000 rows it takes forever! Any help would be much appreciated. Thanks Rachael

**MickG** · 03-26-2009, 07:56 AM

Hi, Try this.
I assumed your Names are in Column "A" and the Dates in Column "B".
The resulting data is in sheet (2) Starts "A1", but you can place in where ever you like by altering the Ranges and sheet at the end of the code.

Sub Trans()
Dim a, K(), Q(), i As Long, n As Long, lCol As Long
Dim Rng As Range
Set Rng = Range(Range("A1"), Range("B" & Rows.Count).End(xlUp))
a = Rng.Value
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) = Format(a(i, 2), "dd/mm/yy")
          .Add a(i, 1), Array(n, 2)
Else
         Q = .Item(a(i, 1))
         Q(1) = Q(1) + 1
         K(Q(0), Q(1)) = Format(a(i, 2), "dd/mm/yy")
         lCol = Application.Max(lCol, Q(1))
         .Item(a(i, 1)) = Q
         End If
    Next

 With Sheets("Sheet2")
    .Range("A1").Resize(n, lCol).Value = K
    .Columns.AutoFit
 End With
End With
End Sub

Regards Mick

**rachbendy** · 03-26-2009, 08:38 AM

Hi Mick

You are a genius! It works a treat, thanks

I just need a little more help please...my appointment dates are actually in column G, and there are quite a few other bits of data in B to F which I need to pop onto the other sheet too? is this possible? If not I'm sure i can VLOOKUP back to the original sheet.

Thanks for all your help, I would have never managed to write the code myself as I only have a very basic vb knowledge so thanks again!

Rachael

**MickG** · 03-26-2009, 10:02 AM

Hi, Try this:-
This code Is Based on Column "F" (Peoples Names) but included related data from the Columns "B" To "E" and the dates in column "G".
NB:- This extra will be Data in columns "B" To "E" for each first found individual Name in column "F", Subsequent different data in columns "B" to "E" wil not be found.
The results are in sheet(2) starting "A2".

Sub Trans2()
Dim a, K(), Q(), i As Long, n As Long, lCol As Long
Dim Rng As Range, c
Set Rng = Range(Range("B1"), Range("G" & Rows.Count).End(xlUp))
a = Rng.Value
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, 5)) Then
           n = n + 1
           K(n, 1) = a(i, 1): K(n, 2) = a(i, 2): K(n, 3) = a(i, 3)
           K(n, 4) = a(i, 4): K(n, 5) = a(i, 5)
           K(n, 6) = Format(a(i, 6), "dd/mm/yy")
          .Add a(i, 5), Array(n, 6)
 Else
         Q = .Item(a(i, 5))
         Q(1) = Q(1) + 1
         K(Q(0), Q(1)) = Format(a(i, 6), "dd/mm/yy")
         lCol = Application.Max(lCol, Q(1))
         .Item(a(i, 5)) = Q
         End If
    Next

 With Sheets("Sheet2")
    .Range("A2").Resize(n, lCol).Value = K
    .Columns.AutoFit
 End With
End With
End Sub

Regards Mick

**rachbendy** · 03-26-2009, 10:21 AM

Hi Mick

Thank you so much for this, it is absolutely perfect and works brilliantly - you've just saved me so much time I cannot thank you enough!

Rachael

**maidinsheffield** · 07-15-2012, 09:22 AM

I have a similar problem, ie a list of usernames and the equipment assigned to them. The usernames can appear more than once in the column (A) but the equipment only once in column (B):

AA001397 355931.03.429688.2 Blackberry Smartphone
AA001397 LAP6039851 HP Compaq 6710b Notebook
AA001397 DSK9006511 Lenovo M58
AA001397 VOC000000020 Philips LFH9399 Digital Voice Recorder Kit
AA028884 PS/W000000212 Dragon Naturally Speaking Software
AA028884 DSK9003363 Lenovo M58
AA028884 LAP9003797 Lenovo ThinkPad T400 Notebook
AA042046 DSK9003960 Lenovo M58
AA042046 LAP9002938 Lenovo Thinkpad T410 Laptop
AA042046 351858.01.876461.9 Nokia Mobile Phone
AA06068 LAP9007635 Lenovo Thinkpad T410 Laptop
AA06218 DSK9007000 Lenovo M58
AA41159 356920.01.619575.9 Blackberry Smartphone
AA41159 LAP6037617 HP Compaq nc6320 Notebook
AA41159 31-8550487-6 RAS FOB
AA41725 DSK9011269 Lenovo M58
AA53667 DSK9000094 Lenovo M58
AA53667 DSK9005981 Lenovo M58
AA53667 31-8549814-4 RAS FOB
AA60942 DSK6030102 HP Compaq dc7100 SFF
AA62112 DSK9009934 Lenovo M58
AA62112 LAP9007486 Lenovo X201 Notebook Laptop
AA62112 31-6707554-8 RAS FOB
AA62112 DSK6031396 HP Compaq dc7600 SFF

Is there a way to show the user only once and the equipment in cells along the same row as the username - I need a formula and not code.

Thanks
MIS

**Cutter** · 07-15-2012, 09:41 AM

Hello maidinsheffield, and welcome to the forum. Unfortunately, you've inadvertently broken a forum rule. Please read the following. Thanks.

Your post does not comply with Rule 2 of our Forum RULES. Don't post a question in the thread of another member -- start your own thread. If you feel it's particularly relevant, provide a link to the other thread. It makes sense to have a new thread for your question because a thread with numerous replies can be off putting & difficult to pick out relevant replies.