Converting horizontal list to vertical - VBA

[mhaidar81]

Hello all,

I am looking for a macro that would convert a horizontal list to a vertical one. All I can come up with is a macro to copy the row and paste it X number of times, but my list contains thousands of rows and doesn't seem very practical. Assuming ID column is column A:

A ---​ ID	B ---​ Project	C ---​ Rate	D --- Project A Count	E --- Project B Count	F --- Project C Count	G --- ​ Total	H ---​ Rate	I --- Project D Count	J --- Project E Count	K --- Project D Count	L --- ​ Total
1001	12001.01	$50	3	0	5	400	60	6	1	0	420

<tbody>
</tbody>

ID	Project	Project Name	Rate	Count	Total
1001	Project A	12001.01	$50	3	150
1001	Project B	12001.01	$50	0	0
1001	Project C	12001.01	$50	5	250
1001	Project D	FR0006	$60	6	360
1001	Project E	FR0003	$60	1	60
1001	Project F	FR0005	$60	0	0

<tbody>
</tbody>

After the list is converted:

• Project A, Project B, and Project C should always populate “Project Name” with the value from Column B
• Project D should populate “Project Name” with the value “FR0006”
• Project E should populate “Project Name” with the value “FR0003”
• Project F should populate “Project Name” with the value “FR0005”

I would appreciate any help with this

 

[mhaidar81]

Hey guys, I have a follow-up question on this. Let's say that there are additional columns within my sheet that contain useless information and I have no interest in converting them into the vertical format. Can I select the columns that I'm only interested in? The number of columns will be fixed in the sheet.

 

[mhaidar81]

Never mind, I figured it out!

Hey guys, I have a follow-up question on this. Let's say that there are additional columns within my sheet that contain useless information and I have no interest in converting them into the vertical format. Can I select the columns that I'm only interested in? The number of columns will be fixed in the sheet.

 

[mse330]

You can do that in my code by changing the below

Set Rg = ActiveSheet.Range("A1").CurrentRegion '<--- Comment/delete this line

Set Rg = ActiveSheet.Range("A1", Range("L" & Rows.Count).End(xlUp))  '<--- Replace with this line