Copy some data from horizontal to vertical

[hoody24]

Hi there, I have a worksheet which looks like this:
[TABLE="width: 457"]
<colgroup><col><col><col span="5"></colgroup><tbody>[TR]
[TD]
P/N[/TD]
[TD]
Description[/TD]
[TD]
Nov-13[/TD]
[TD]
Dec-13[/TD]
[TD]
Jan-14[/TD]
[TD]
Feb-14
[/TD]
[TD]
Mar-14[/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]Part 1[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]15[/TD]
[TD]20[/TD]
[TD]25[/TD]
[/TR]
[TR]
[TD]1001[/TD]
[TD]Part 2[/TD]
[TD]2[/TD]
[TD]4[/TD]
[TD]6[/TD]
[TD]8[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]1002[/TD]
[TD]Part 3[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]9[/TD]
[TD]12[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]1003[/TD]
[TD]Part 4[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]7[/TD]
[TD]10[/TD]
[TD]13[/TD]
[/TR]
</tbody>[/TABLE]

I would like the list to appear like this - is there any formula/VBA that will do this for me - been tearing my hair out over this for hours, any help would be greatly appreciated!

P/N Description Date Qty
1000 Part 1 Nov 13 5
1000 Part 1 Dec 13 10
1000 Part 1 Jan 14 15
1000 Part 1 Feb 14 20
1000 Part 1 Mar 14 25
1001 Part 2 Nov 13 2
1001 Part 2 Dec 13 4
1001 Part 2 Jan 14 6
1001 Part 2 Feb 14 8
1001 Part 2 Mar 14 10
1002 Part 3 Jan 14 3
1002 Part 3 Feb 14 6


Many thanks,

H24

 

[patel45]

result in sheet 2

Sub a()
sheets(1).activate
LR = ActiveSheet.UsedRange.Rows.Count
LC = ActiveSheet.UsedRange.Columns.Count
Set sh2 = Sheets(2)
drow = 2
For r = 2 To LR
  Set pndes = Range("A" & r & ":B" & r)
  For c = 3 To LC
    sh2.Range("A" & drow & ":B" & drow).Value = pndes.Value
    sh2.Range("C" & drow).Value = Cells(1, c).Value
    sh2.Range("D" & drow).Value = Cells(r, c).Value
    drow = drow + 1
  Next
Next
sheets(2).activate
End Sub

 

[hiker95]

hoody24,

Welcome to the MrExcel forum.

I assume that your raw data is in worksheet Sheet1. If this is not correct, then let me know the correct worksheet name.

Sample raw data in worksheet Sheet1:

Excel 2007
	A	B	C	D	E	F	G
1	P/N	Description	Nov-13	Dec-13	Jan-14	Feb-14	Mar-14
2	1000	Part 1	5	10	15	20	25
3	1001	Part 2	2	4	6	8	10
4	1002	Part 3	3	6	9	12	15
5	1003	Part 4	1	4	7	10	13
6
Sheet1

After the macro in a new worksheet Results (macro runtime using two arrays in memory was 0.000 seconds):

Excel 2007
	A	B	C	D
1	P/N	Description	Date	Qty
2	1000	Part 1	Nov 13	5
3	1000	Part 1	Dec 13	10
4	1000	Part 1	Jan 14	15
5	1000	Part 1	Feb 14	20
6	1000	Part 1	Mar 14	25
7	1001	Part 2	Nov 13	2
8	1001	Part 2	Dec 13	4
9	1001	Part 2	Jan 14	6
10	1001	Part 2	Feb 14	8
11	1001	Part 2	Mar 14	10
12	1002	Part 3	Nov 13	3
13	1002	Part 3	Dec 13	6
14	1002	Part 3	Jan 14	9
15	1002	Part 3	Feb 14	12
16	1002	Part 3	Mar 14	15
17	1003	Part 4	Nov 13	1
18	1003	Part 4	Dec 13	4
19	1003	Part 4	Jan 14	7
20	1003	Part 4	Feb 14	10
21	1003	Part 4	Mar 14	13
22
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.

Option Explicit
Sub ReorgData()
' hiker95, 10/22/2013
' http://www.mrexcel.com/forum/excel-questions/734216-copy-some-data-horizontal-vertical.html
Dim a As Variant, o As Variant
Dim i As Long, ii As Long, c As Long
With Sheets("Sheet1")
  a = .Cells(1).CurrentRegion
  ReDim o(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 2), 1 To 4)
End With
For i = 2 To UBound(a, 1)
  For c = 3 To UBound(a, 2)
    ii = ii + 1
    o(ii, 1) = a(i, 1): o(ii, 2) = a(i, 2): o(ii, 3) = a(1, c): o(ii, 4) = a(i, c)
  Next c
Next i
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=Sheets("Sheet1")).Name = "Results"
With Sheets("Results")
  .UsedRange.ClearContents
  .Cells(1, 1).Resize(, 4).Value = [{"P/N","Description","Date","Qty"}]
  .Cells(2, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Cells(2, 3).Resize(UBound(o, 1)).NumberFormat = "mmm yy"
  .Columns.AutoFit
  .Activate
End With
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.

 

[hoody24]

Thanks patel45 and hiker95, both of those macros are working perfectly.

I now have two more text columns

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]P/N[/TD]
[TD]Description[/TD]
[TD]Country[/TD]
[TD]Customer[/TD]
[TD]Nov 13[/TD]
[TD]Dec 13[/TD]
[TD]Jan 14[/TD]
[TD]Feb 14[/TD]
[TD]Mar 14[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1000[/TD]
[TD]Part 1[/TD]
[TD]Belgium[/TD]
[TD]Jim[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]15[/TD]
[TD]20[/TD]
[TD]25[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]1001[/TD]
[TD]Part 2[/TD]
[TD]Greece[/TD]
[TD]Joe[/TD]
[TD]2[/TD]
[TD]4[/TD]
[TD]6[/TD]
[TD]8[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]1002[/TD]
[TD]Part 3[/TD]
[TD]France[/TD]
[TD]John[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]9[/TD]
[TD]12[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]1003[/TD]
[TD]Part 4[/TD]
[TD]Spain[/TD]
[TD]Jack[/TD]
[TD]1[/TD]
[TD]4[/TD]
[TD]7[/TD]
[TD]10[/TD]
[TD]13[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I'm not very familiar with macros - I think yours may be the first I have employed successfully - but how would I incorporate these two extra columns into your respective macros?

Many thanks,

H24

 

[hoody24]

Solved the addition of two extra columns and learned some VBA while I was doing it too, here's the code I used which spat out exactly what I wanted

Sub a()
Sheets(1).Activate
LR = ActiveSheet.UsedRange.Rows.Count
LC = ActiveSheet.UsedRange.Columns.Count
Set sh2 = Sheets(2)
drow = 2
For r = 2 To LR
Set pndes = Range("A" & r & ":B" & r & ":E" & r)
For c = 5 To LC
sh2.Range("A" & drow & ":B" & drow).Value = pndes.Value
sh2.Range("C" & drow).Value = Cells(r, 3).Value
sh2.Range("D" & drow).Value = Cells(r, 4).Value
sh2.Range("E" & drow).Value = Cells(1, c).Value
sh2.Range("F" & drow).Value = Cells(r, c).Value
drow = drow + 1
Next
Next
Sheets(2).Activate
End Sub

With thanks again to the respondees, and in the knowledge of many, many more questions I'll be asking. Great site!

 

[hiker95]

hoody24,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.


If posting VBA code, please use Code Tags - like this:

[code=rich]

Paste your code here.

[/code]