Transposing data SETS from vertical to horizontal

[tutuzdad]

I desperately need to transpose multiple SETS of data so that the now vertical columns are horizontal. I know about transposing but not when it comes to sets. For simplicity sake let’s say I have a long list of multiple addresses with the headers, NAME, ADDR, CITY, STATE, ZIP. Transposing these headers into a horizontal table is fairly simple. It’s getting the 5 rows of names, addresses, cities, states and zips under the correct headers that has me confounded. I’m using 2010. I’m pretty familiar with excel. Ideally a solution that I can reapply to future lists since this is something I do regularly and my output is always formatted this same annoying way. I don’t do VB but if we have to and you can simply it step-by-step for me I’d really appreciate it.

 

[hiker95]

tutuzdad,

If I now understand you correctly.

Here is a macro solution for you to consider that should adjust to the varying number of rows, and, columns in your raw data worksheet.

Sample raw data in worksheet Sheet1 (you can change the raw data worksheet name in the macro):

Excel 2007
	A	B	C	D	E
1	Name	Fred	Carl	Norman
2	Addr	101 Main St.	21 First St.	200 Paved St.
3	City	Anchorage	Cliford	Austin
4	State	AK	ND	TX
5	Zip	99501	58016	73301
6
Sheet1

After the macro (using two arrays in memory) in a new worksheet Results:

Excel 2007
	A	B	C	D	E	F
1	Name	Addr	City	State	Zip
2	Fred	101 Main St.	Anchorage	AK	99501
3	Carl	21 First St.	Cliford	ND	58016
4	Norman	200 Paved St.	Austin	TX	73301
5
Results

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.

Sub TransposeData()
' hiker95, 03/18/2015, ME842652
Dim w1 As Worksheet, wr As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long, c As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   ''<-- change the raw data worksheet name here
a = w1.Cells(1, 1).CurrentRegion
ReDim o(1 To UBound(a, 2), 1 To UBound(a, 1))
For c = 1 To UBound(a, 2)
  j = j + 1
  For i = 1 To UBound(a, 1)
    o(j, i) = a(i, c)
  Next i
Next c
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
With wr
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).Resize(, UBound(o, 2)).AutoFit
  .Activate
End With
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the TransposeData macro.

 

[hiker95]

tutuzdad,

Using some of the raw data displayed by Lee., and, the above macro.

Excel 2007
	A	B	C	D	E	F
1	first_name	Aleshia	Evan	France	Ulysses
2	last_name	Tomkiewicz	Zigomalas	Andrade	Mcwalters
3	company_name	Alan D Rosenburg Cpa Pc	Cap Gemini America	Elliott, John W Esq	Mcmahan, Ben L
4	address	14 Taylor St	5 Binney St	8 Moor Place	505 Exeter Rd
5	city	St. Stephens Ward	Abbey Ward	East Southbourne and Tuckton W	Hawerby cum Beesby
6	county	Kent	Buckinghamshire	Bournemouth	Lincolnshire
7	postal	CT2 7PP	HP11 2AX	BH6 3BE	DN36 5RP
8	phone1	01835-703597	01937-864715	01347-368222	01912-771311
9	phone2	01944-369967	01714-737668	01935-821636	01302-601380
10	email	atomkiewicz@hotmail.com	evan.zigomalas@gmail.com	france.andrade@hotmail.com	ulysses@hotmail.com
11
Sheet1

And, the results in 2 screenshots to fit the MrExcel display area:

Excel 2007
	A	B	C	D	E
1	first_name	last_name	company_name	address	city
2	Aleshia	Tomkiewicz	Alan D Rosenburg Cpa Pc	14 Taylor St	St. Stephens Ward
3	Evan	Zigomalas	Cap Gemini America	5 Binney St	Abbey Ward
4	France	Andrade	Elliott, John W Esq	8 Moor Place	East Southbourne and Tuckton W
5	Ulysses	Mcwalters	Mcmahan, Ben L	505 Exeter Rd	Hawerby cum Beesby
6
Results

Excel 2007
	F	G	H	I	J	K
1	county	postal	phone1	phone2	email
2	Kent	CT2 7PP	01835-703597	01944-369967	atomkiewicz@hotmail.com
3	Buckinghamshire	HP11 2AX	01937-864715	01714-737668	evan.zigomalas@gmail.com
4	Bournemouth	BH6 3BE	01347-368222	01935-821636	france.andrade@hotmail.com
5	Lincolnshire	DN36 5RP	01912-771311	01302-601380	ulysses@hotmail.com
6
Results

 

[tutuzdad]

tutuzdad, If I now understand you correctly. Here is a macro solution for you to consider that should adjust to the varying number of rows, and, columns in your raw data worksheet. Sample raw data in worksheet Sheet1 (you can change the raw data worksheet name in the macro): Excel 2007

	A	B	C	D	E
1	Name	Fred	Carl	Norman
2	Addr	101 Main St.	21 First St.	200 Paved St.
3	City	Anchorage	Cliford	Austin
4	State	AK	ND	TX
5	Zip	99501	58016	73301
6

<colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

After the macro (using two arrays in memory) in a new worksheet Results: Excel 2007

	A	B	C	D	E	F
1	Name	Addr	City	State	Zip
2	Fred	101 Main St.	Anchorage	AK	99501
3	Carl	21 First St.	Cliford	ND	58016
4	Norman	200 Paved St.	Austin	TX	73301
5

<colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /></colgroup><thead>
</thead><tbody>
</tbody>

Results​

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.

  Sub TransposeData() ' hiker95, 03/18/2015, ME842652 Dim w1 As Worksheet, wr As Worksheet Dim a As Variant, o As Variant Dim i As Long, j As Long, c As Long Application.ScreenUpdating = False Set w1 = Sheets("Sheet1")   ''<-- change the raw data worksheet name here a = w1.Cells(1, 1).CurrentRegion ReDim o(1 To UBound(a, 2), 1 To UBound(a, 1)) For c = 1 To UBound(a, 2)   j = j + 1   For i = 1 To UBound(a, 1)     o(j, i) = a(i, c)   Next i Next c If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results" Set wr = Sheets("Results") With wr   .UsedRange.Clear   .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o   .Columns(1).Resize(, UBound(o, 2)).AutoFit   .Activate End With 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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook. Then run the TransposeData macro.

Thank you. I see you have put a lot of work and thought into your answer and I greatly appreciate it. Due to my own inability to make this easier by uploading my worksheet I can only describe it and hope it makes sense. I only have two columns in my raw data. In your first example above called "Sheet 1", imagine column A exactly the way you have it, however, A6 begins the recurring headers anew, (A6)NAME, (A7)ADDR, (A8)CITY, (A9)STATE, (A10) ZIP, and so forth. These continue to repeat through about A3000. The sets of addresses fall the same way in column B next to the headings in column A and on every 6th row begins a new address set of a name, followed by an address, followed by a city, etc. THOSE are what I need to transpose to a table configuration.

 

[tutuzdad]

I guess you could also say that I need to transpose 5 rows in the column B list to my 5 column table and then the next 5, and the next 5, and so on.

 

[hiker95]

tutuzdad,

NEW sample raw data in worksheet Sheet1 (you can change the raw data worksheet name in the macro):

Excel 2007
	A	B	C
1	Name	Fred
2	Addr	101 Main St.
3	City	Anchorage
4	State	AK
5	Zip	99501
6	Name	Carl
7	Addr	21 First St.
8	City	Cliford
9	State	ND
10	Zip	58016
11	Name	Norman
12	Addr	200 Paved St.
13	City	Austin
14	State	TX
15	Zip	73301
16
Sheet1

After the macro (using two arrays in memory) in a new worksheet Results:

Excel 2007
	A	B	C	D	E	F
1	NAME	ADDR	CITY	STATE	ZIP
2	Fred	101 Main St.	Anchorage	AK	99501
3	Carl	21 First St.	Cliford	ND	58016
4	Norman	200 Paved St.	Austin	TX	73301
5
Results

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).

Sub TransposeData_V2()
' hiker95, 03/18/2015, ME842652
Dim w1 As Worksheet, wr As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   ''<-- change the raw data worksheet name here
a = w1.Cells(1, 1).CurrentRegion
ReDim o(1 To UBound(a, 1) / 5, 1 To 5)
For i = 1 To UBound(a, 1) Step 5
  j = j + 1
  o(j, 1) = a(i, 2)
  o(j, 2) = a(i + 1, 2)
  o(j, 3) = a(i + 2, 2)
  o(j, 4) = a(i + 3, 2)
  o(j, 5) = a(i + 4, 2)
Next i
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
With wr
  .UsedRange.Clear
  .Cells(1, 1).Resize(, 5).Value = Array("NAME", "ADDR", "CITY", "STATE", "ZIP")
  .Cells(2, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).Resize(, UBound(o, 2)).AutoFit
  .Activate
End With
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the TransposeData_V2 macro.

 

[tutuzdad]

THAT IS IT EXACTLY! I knew there was a genius on here somewhere. Now if I may trouble you one time further, if you can just tell me where to tweak this macro recipe so that it accommodates by ACTUAL headers (which I hesitated to burden you with) I can try to apply the tweak what you have given me myself so you won't have to do all that typing. There are 19 of them (these are the repeating headers from column A whose columns will be populated with 19 unique values in column B): City Date1 Date2 Date3 Date4 Number Nature Address State ZIP Contact Area Received by How received Agency Off Geo ID Clear

 

[tutuzdad]

If I knew how to insert a code like you have I would have sent you the whole macro back with at least "some" of the changes already done to save you some time.

 

[hiker95]

tutuzdad,

THAT IS IT EXACTLY!

Thanks for the feedback.

You are very welcome. Glad I could help.

Now if I may trouble you one time further, if you can just tell me where to tweak this macro recipe so that it accommodates by ACTUAL headers

One last try:

So, your actual raw data consists of sets of 19 rows, 2 columns, columns A, and B?

 

[tutuzdad]

tutuzdad, Thanks for the feedback. You are very welcome. Glad I could help. One last try: So, your actual raw data consists of sets of 19 rows, 2 columns, columns A, and B?

That is correct. In my example I dumbed it down to only 5 and called it an address list because it's the same concept and I felt really bad asking someone to spend a great deal of time formatting all of the REAL stuff for me. But now that the macro is written and the basic problem is solved, I thought maybe I can simply replace a few lines with my real 19 row headers and modify it to suit my needs (which I will gladly do if you can just point out which lines need it).

 

[hiker95]

tutuzdad,

New sample raw data in worksheet Sheet1 (you can change the raw data worksheet name in the macro):

Excel 2007
	A	B	C
1	A	1
2	B	2
3	C	3
4	D	4
5	E	5
6	F	6
7	G	7
8	H	8
9	I	9
10	J	10
11	K	11
12	L	12
13	M	13
14	N	14
15	O	15
16	P	16
17	Q	17
18	R	18
19	S	19
20	A	20
21	B	21
22	C	22
23	D	23
24	E	24
25	F	25
26	G	26
27	H	27
28	I	28
29	J	29
30	K	30
31	L	31
32	M	32
33	N	33
34	O	34
35	P	35
36	Q	36
37	R	37
38	S	38
39	A	39
40	B	40
41	C	41
42	D	42
43	E	43
44	F	44
45	G	45
46	H	46
47	I	47
48	J	48
49	K	49
50	L	50
51	M	51
52	N	52
53	O	53
54	P	54
55	Q	55
56	R	56
57	S	57
58
Sheet1

After the macro (using two arrays in memory) in a new worksheet Results:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
1	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
2	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19
3	20	21	22	23	24	25	26	27	28	29	30	31	32	33	34	35	36	37	38
4	39	40	41	42	43	44	45	46	47	48	49	50	51	52	53	54	55	56	57
5
Results

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).

Sub TransposeData_V3()
' hiker95, 03/18/2015, ME842652
Dim w1 As Worksheet, wr As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   ''<-- change the raw data worksheet name here
a = w1.Cells(1, 1).CurrentRegion
ReDim o(1 To UBound(a, 1) / 19, 1 To 19)
For i = 1 To UBound(a, 1) Step 19
  j = j + 1
  o(j, 1) = a(i, 2)
  o(j, 2) = a(i + 1, 2)
  o(j, 3) = a(i + 2, 2)
  o(j, 4) = a(i + 3, 2)
  o(j, 5) = a(i + 4, 2)
  o(j, 6) = a(i + 5, 2)
  o(j, 7) = a(i + 6, 2)
  o(j, 8) = a(i + 7, 2)
  o(j, 9) = a(i + 8, 2)
  o(j, 10) = a(i + 9, 2)
  o(j, 11) = a(i + 10, 2)
  o(j, 12) = a(i + 11, 2)
  o(j, 13) = a(i + 12, 2)
  o(j, 14) = a(i + 13, 2)
  o(j, 15) = a(i + 14, 2)
  o(j, 16) = a(i + 15, 2)
  o(j, 17) = a(i + 16, 2)
  o(j, 18) = a(i + 17, 2)
  o(j, 19) = a(i + 18, 2)
Next i
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
With wr
  .UsedRange.Clear
  .Cells(1, 1).Resize(, 19).Value = Application.Transpose(w1.Range("A1:A19"))
  .Cells(2, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).Resize(, UBound(o, 2)).AutoFit
  .Activate
End With
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the TransposeData_V3 macro.