macro to transpose data

[Tody03]

Need help to write a macro that will take data from "original data" and transpose it.
The length of the group in the name column is unknown


Original data
Name
A 5
A 8
A 2
b 7
b 33
b 44
c 9
c 3
c 77

Transposed data
a 5 8 2
b 7 33 44
c 9 3 77


Thanks
Tody

 

[ace19852]

Hi Tody and welcome to the board,

I have produced a formula based solution which could be recorded and turned into a macro if you really needed it.

First you show each Original Name A,b and c always has 3 instances as per your example

Ok so row 1 is headings

Columns A Original Name and B Data

Column D1 Transposed data
D2 download ward is the unique Original Name A,b and c

E2
=OFFSET(E2,K2,-3)

F2
=OFFSET(F2,L2,-4)

G2
=OFFSET(G2,M2,-5)

Copy down as far as required E2,F2 and G2 in this case 2 columns

K1
Row offset for formula drag down

K2
=0
K3
=K2+2

L2
=1
L3
=L2+2

M2
=2
M3
=M2+2

Copy down as far as required K3,L3 and M3 in this case 2 columns

I also attached the test file as it's probably easier to see

https://www.sendspace.com/file/dyvtpa

Cheers

 

[hiker95]

Tody03,

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?


You did ask for a macro solution.

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G
1	Name
2	A	5
3	A	8
4	A	2
5	b	7
6	b	33
7	b	34
8	c	9
9	c	3
10	c	77
11
Sheet1

After the macro:

Excel 2007
	A	B	C	D	E	F	G
1	Name			Transposed
2	A	5		A	5	8	2
3	A	8		b	7	33	34
4	A	2		c	9	3	77
5	b	7
6	b	33
7	b	34
8	c	9
9	c	3
10	c	77
11
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Compare Text
Sub ReorgData()
' hiker95, 06/28/2014, ME787828
Dim c As Range, a As Range, lc As Long, nc As Long
Application.ScreenUpdating = False
lc = Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
If lc > 2 Then Columns(4).Resize(, lc).ClearContents
Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns(4), Unique:=True
Cells(1, 4).Value = "Transposed"
For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
  If c <> "" Then
    Set a = Columns(4).Find(c.Value, LookAt:=xlWhole)
    If Not a Is Nothing Then
      nc = Cells(a.Row, Columns.Count).End(xlToLeft).Column + 1
      Cells(a.Row, nc).Value = c.Offset(, 1).Value
    End If
  End If
Next c
Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.

 

[ace19852]

Hi thanks Hikers, Yes and I did realise that Tody had asked for a macro solution but I thought I'd throw in my solution anyway.

I tried your macro works brilliantly and it covers additional instances i.e. as many instances of each letter as you choose to use.

I'm going to look and learn from your code. As I need to improve my VBA

Cheers

 

[Tody03]

Hi
I have to study your solution and see how to implement it.
Thanks

 

[Tody03]

Hi Ace
I have to study and test your solution.
thanks

 

[Tody03]

Hi Hiker
I do not understand exactly what you do, but i followed your instruction and IT IS WORKING EXACTLY AS I WANTED.
My day was more than just a great day.
Thanks

 

[hiker95]

ace19852,

I tried your macro works brilliantly and it covers additional instances i.e. as many instances of each letter as you choose to use.

I'm going to look and learn from your code. As I need to improve my VBA

Thanks for the feedback.

You are very welcome. Glad I could help.

 

[hiker95]

Tody03,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.