reorganising data

[ellison]

Hi, my job (joy of joys!) is to collate the different reports that we get in from different departments around the organisation...
and there is one really repetitive aspect of it that leaves my fingers (& head) numb from all of the copying and pasting. I'm hoping that somebody may be able to suggest something to help automate this...

In short, part of the info in the the reports that we receive is organised into columns. And we'd like it to be sort of re-organised into rows.
As simple as this sounds, it's taking ages with a really convoluted set of lookups, filters & concatenations!

Here is a brief sample of what we are getting at (by the way, the reports can sometimes be 100,000 lines +. (And we have told the the powers that be that Excel isn't really designed for storing data that way, but it seems to fall on deaf ears, grr!)

Here is a sample of the incoming data:

Department Comment XYZ789 <tbody> </tbody> average <tbody> </tbody> XYZ789 <tbody> </tbody> supersedes <tbody> </tbody> XYZ789 <tbody> </tbody> not declared <tbody> </tbody> P1444453.12 <tbody> </tbody> excellent!!!! <tbody> </tbody> Hammersmith <tbody> </tbody> time lag on sales <tbody> </tbody> Liverpool <tbody> </tbody> headcount issue <tbody> </tbody> Liverpool <tbody> </tbody> excellent! <tbody> </tbody> Liverpool good <tbody> </tbody> Liverpool good Orange <tbody> </tbody> good-ish <tbody> </tbody> Red <tbody> </tbody> below average <tbody> </tbody> Purple <tbody> </tbody> concerning <tbody> </tbody> Purple problem <tbody> </tbody> <tbody> </tbody>

<tbody>
</tbody>

..... And here is how we would like the info to appear after being reorganised:

Department <tbody> </tbody>	Comment 1	Comment 2	Comment 3	Comment 4
XYZ789 <tbody> </tbody>	average <tbody> </tbody>	supersedes <tbody> </tbody>	not declared <tbody> </tbody>
P1444453.12 <tbody> </tbody>	excellent!!!! <tbody> </tbody>
Hammersmith <tbody> </tbody>	time lag on sales <tbody> </tbody>
Liverpool <tbody> </tbody>	headcount issue <tbody> </tbody>	excellent! <tbody> </tbody>	good <tbody> </tbody>	good <tbody> </tbody>
Red <tbody> </tbody>	below average <tbody> </tbody>
Purple <tbody> </tbody>	concerning <tbody> </tbody>	problem <tbody> </tbody>

<tbody>
</tbody>

If you could point me in the right direction, it would be MASSIVELY appreciated!!! (by me and by me ever-so-numb fingertips!!!)

With thanks

Neil

 

[Fluff]

How about

Sub ConverttoRows()
   Dim Cl As Range
   Dim Ky As Variant
   Dim Dic As Object
   Dim Ary As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      If Not Dic.exists(Cl.Value) Then
         Dic.Add Cl.Value, Cl.Offset(, 1).Value
      Else
         Dic(Cl.Value) = Dic(Cl.Value) & "|" & Cl.Offset(, 1).Value
      End If
   Next Cl
   For Each Ky In Dic.keys
      With Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1)
         .Value = Ky
         Ary = Split(Dic(Ky), "|")
         If UBound(Ary) > 0 Then
            .Offset(, 1).Resize(, UBound(Ary) + 1).Value = Ary
         Else
            .Offset(, 1).Value = Ary
         End If
      End With
   Next Ky
End Sub

 

[ellison]

Many thanks indded...
But I'm getting an error:

"runtime error '9'. Subscript out of range". When I hit debug, the line of code that is highlighted is:

With Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1)



Does that help?!

 

[Fluff]

You need to change the sheet name, to the sheet you want the output on.

 

[ellison]

That is ABSOLUTELY AMAZING.......... My fingertips and I are extremely grateful!!!!!!!!!!!!!!!!!!!!

Thank you very much

Best

Neil

 

[Fluff]

Glad to help & thanks for the feedback