Transpose!!

[saybut]

Hi, I have quite a tricky problem.. (I've attached a sheet as a
example, I'll explain it further down)

I have a list of names in column a (a very large amount), there ar
lots of duplicate names, and next to them in column b are th
categories associated with each name. So if a name is repeated 5 time
in column a, it will have 5 different categories.

I need to summarize it so that I only have 1 name per person, but al
of the categories associated with the person going along in each colum
as per the sheet attached.

I've been trying to figure it out but can't do it (except manual past
special>transpose which would take me weeks!)

If anyone has any idea how I could possibly automate this I'd be ver
grateful.

thanks very much for any suggestions.

regards

+-------------------------------------------------------------------
|Filename: Example_Transpose.zip
|Download: http://www.excelforum.com/attachment.php?postid=4426
+-------------------------------------------------------------------

 

[Guest]

test post

 

[Guest]

create two new columns having the following formulas:
Column C: =IF(A2=A1,CONCATENATE(B2,", ",C1),B2)
Column D: =IF(A2=A3,1,0)

(This is assuming that A is your "names" column, and B is your "Categories"
column, and that Row 1 contains column names or is blank)

After you have filled down, sort the spreadsheet by column D (so all the
zeroes are first)

This should arrange things so the upper portion of you spreadsheet contains
the combined categories for every name, and each name is listed only once.

 

[Guest]

Hi,
Try this - input from "Sheet1" to output "Sheet2"

Sub a()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, r As Long, n As Integer
Dim rnga As Range
r = 2

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

ws2.Range("a1:f1") = Array("E-Mail", "Category", "Category", "Category",
"Category", "Category")

With ws1
lastrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
Set rnga = ws1.Range("a2:a" & lastrow)
Do
n = Application.CountIf(rnga, .Cells(r, "A"))
.Cells(r, "A").Copy ws2.Cells(Rows.Count, "A").End(xlUp)(2)
.Cells(r, "B").Resize(n, 1).Copy
ws2.Cells(ws2.Cells(Rows.Count, "A").End(xlUp).Row, "B").Resize(1,
n) _
.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False, Transpose:=True
r = r + n
Loop Until r > lastrow
End With
End Sub

 

[saybut]

Hi, thank you so much for your replies, they're brilliant, thanks a
lot.

I've ended up using yours Anne just for the simplicity and the speed.

Thanks very much again for helping me, I really appreciate it.

Regards,

Mark.