How To Transpose Multiple sets of data in rows to column

[pynky]

Hello,

I am trying to transpose DataName/DataValue pair of data into multiple columns. The problem is, not every data set contains the same number of items, or the same DataNames, and DataNames can be in any order (with exception to the first one, "Name")

The constant is that every data set starts with the "Name" as the beginning of the set, and ends with a blank row.

Example:

[FONT=Courier New]   A        B[/FONT]
[FONT=Courier New]1  Name     Billy[/FONT]
[FONT=Courier New]2  Date     January[/FONT]
[FONT=Courier New]3  Size     10[/FONT]
[FONT=Courier New]4[/FONT]
[FONT=Courier New]5  Name     John[/FONT]
[FONT=Courier New]6  Weight   150[/FONT]
[FONT=Courier New]7  Color    Green[/FONT]
[FONT=Courier New]8  Type     Left[/FONT]
[FONT=Courier New]9[/FONT]
[FONT=Courier New]10 Name     Sean[/FONT]
[FONT=Courier New]11 Size     12[/FONT]
[FONT=Courier New]12 Weight   170[/FONT]
[FONT=Courier New]13[/FONT]

The output would look something like this:

[FONT=Courier New]    A       B        C       D        E      F[/FONT]
[FONT=Courier New]1  Name    Date      Size   Weight   Color   Type[/FONT]
[FONT=Courier New]2  Billy   January   10[/FONT]
[FONT=Courier New]3  John                     150      Green   Left[/FONT]
[FONT=Courier New]4  Sean              12     170[/FONT]

Can anyone help with a macro for this?

 

[meldoc]

Hello and welcome to MeExcel

Try this, please test on a copy, of your data.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> test()<br> ro = 2<br> a = Array("Name", "Date", "Size", "Weight", "Color", "Type")<br>  <SPAN style="color:#00007F">With</SPAN> Sheet1<br>    .Cells(1, "C").Resize(, 6) = a<br>    lr1 = .Cells(Rows.Count, "A").End(xlUp).Row<br>      <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> lr1<br>          cel = Cells(i, "A")<br>            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> cel<br>              <SPAN style="color:#00007F">Case</SPAN> "Name"<br>                col = 3<br>              <SPAN style="color:#00007F">Case</SPAN> "Date"<br>                col = 4<br>              <SPAN style="color:#00007F">Case</SPAN> "Size"<br>                col = 5<br>              <SPAN style="color:#00007F">Case</SPAN> "Weight"<br>                col = 6<br>              <SPAN style="color:#00007F">Case</SPAN> "Color"<br>                col = 7<br>              <SPAN style="color:#00007F">Case</SPAN> "Type"<br>                col = 8<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>          <SPAN style="color:#00007F">If</SPAN> cel <> "" <SPAN style="color:#00007F">Then</SPAN><br>            .Cells(ro, col) = .Cells(i, "B")<br>          <SPAN style="color:#00007F">Else</SPAN><br>            ro = ro + 1<br>          <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>      <SPAN style="color:#00007F">Next</SPAN> i<br>    <SPAN style="color:#007F00">'.Columns("A:B").Delete</SPAN><br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[hiker95]

pynky,

The macro will adjust for a variable number of columns (titles from columm A) beginning in coliumn D with Name.


Sample data befor the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	Name	Billy
2	Date	January
3	Size	10
4
5	Name	John
6	Weight	140
7	Color	Green
8	Type	Left
9
10	Name	Sean
11	Size	12
12	Weight	170
13
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	Name	Billy		Name	Color	Date	Size	Type	Weight
2	Date	January		Billy		January	10
3	Size	10		John	Green			Left	140
4				Sean			12		170
5	Name	John
6	Weight	140
7	Color	Green
8	Type	Left
9
10	Name	Sean
11	Size	12
12	Weight	170
13
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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 04/14/2011
' http://www.mrexcel.com/forum/showthread.php?t=543703
Dim LR As Long, SR As Long, ER As Long, a As Long, NR As Long, FC As Long
Dim AArea As Range
Application.ScreenUpdating = False
Rows(1).Insert
Cells(1, 1) = "Test"
Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns(4), Unique:=True
LR = Cells(Rows.Count, 4).End(xlUp).Row
Range("D3:D" & LR).Sort Key1:=Range("D3"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
LR = Cells(Rows.Count, 4).End(xlUp).Row
Range("E2").Resize(, LR - 1).Value = Application.Transpose(Range("D2:D" & LR))
'Range("D2:D" & LR).ClearContents
Columns(4).Delete
Rows(1).Delete
For Each AArea In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With AArea
    NR = Range("D" & Rows.Count).End(xlUp).Offset(1).Row
    SR = .Row
    ER = SR + .Rows.Count - 1
    Range("D" & NR) = Range("B" & SR)
    For a = SR + 1 To ER Step 1
      FC = Application.Match(Cells(a, 1), Rows(1), 0)
      Cells(NR, FC) = Cells(a, 2)
    Next a
  End With
Next AArea
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.


If the data will always have Date, then I could adjust the macro so that the titles beginning in D1 = Name, E1 = Date.

 

[hiker95]

pynky,

Welcome to the MrExcel forum.

 

[pynky]

Thank you hiker95!!!

It worked beautifully! Now If only I could figure out how it worked, lol.

The macro doesnt appear to use the word "Name" to begin the search dataset, does it just take whatever is in A1 as the constant and the "start" of the dataset?

 

[hiker95]

pynky,

You are very welcome. Glad I could help.

The macro doesnt appear to use the word "Name" to begin the search dataset

If I searched for the word Name in Rows(1), I would only find Name in cell A1, and not in cell D1.

''For each AArea in column A, this line of code copies the persons name in column B To column D:

    Range("D" & NR) = Range("B" & SR)