Macro Help Required for Multiple Column to Single Column Conversion (With Header Info)

[charpotro]

Dear Experts,

I intend to re-arrange the data generated by system. I am using Office 2010

Current Format:

Mat No Cost1 Cost2 Cost3
A 5 3 2
B 6 9 3
C 7 6 2

To be Format:

Mat No
A 5 Cost1
B 6 Cost1
C 7 Cost1
A 3 Cost2
B 9 Cost2
C 6 Cost2
A 2 Cost3
B 3 Cost3
C 2 Cost3


Will be greatful if anybody can suggest the VB code for the rearrangement. The 'Mat No' header is optional, it may or may not appear in the 'to be' format - whichever is easier.

Regards

 

[charpotro]

Sorry, the formats in the original post may not be legible, revising it here:

Current Format:

Mat No	Cost1	Cost2	Cost3
A	5	3	2
B	6	9	3
C	7	6	2

<COLGROUP><COL style="WIDTH: 48pt" span=4 width=64><TBODY>
</TBODY>

To be Format:

Mat No
A	5	Cost1
B	6	Cost1
C	7	Cost1
A	3	Cost2
B	9	Cost2
C	6	Cost2
A	2	Cost3
B	3	Cost3
C	2	Cost3

<COLGROUP><COL style="WIDTH: 48pt" span=3 width=64><TBODY>
</TBODY>

Regards

 

[hiker95]

charpotro,

Welcome to the MrExcel forum.

Be right back.

 

[hiker95]

charpotro,

Welcome to the MrExcel forum.

The below macro will adjust for a varying number or rows, and, columns.


If the raw data is not in worksheet Sheet1, then, let me know the actual raw data worksheet name, and, I will adjust the macro.

If you want to have the results in a new worksheet, then let me known the new worksheet name.


Sample raw data on worksheet Sheet1:

Excel 2007
	A	B	C	D	E	F	G	H	I
1	Mat No	Cost1	Cost2	Cost3
2	A	5	3	2
3	B	6	9	3
4	C	7	6	2
5
6
7
8
9
10
11
Sheet1

After the macro using two arrays in memory:

Excel 2007
	A	B	C	D	E	F	G	H	I
1	Mat No	Cost1	Cost2	Cost3			Mat No
2	A	5	3	2			A	5	Cost1
3	B	6	9	3			B	6	Cost1
4	C	7	6	2			C	7	Cost1
5							A	3	Cost2
6							B	9	Cost2
7							C	6	Cost2
8							A	2	Cost3
9							B	3	Cost3
10							C	2	Cost3
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.

Sub ReorgData()
' hiker95, 07/24/2014, ME793789
Dim a As Variant, o As Variant
Dim i As Long, j As Long, c As Long
Dim lr As Long, lc As Long, luc As Long, n As Long
With Sheets("Sheet1")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, 1).End(xlToRight).Column
  luc = .Cells(1, Columns.Count).End(xlToLeft).Column
  If luc > lc Then .Columns(luc).Resize(, 3).ClearContents
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  n = Application.CountA(.Range(.Cells(2, 2), .Cells(lr, lc)))
  ReDim o(1 To n, 1 To 3)
  For c = 2 To lc Step 1
    For i = 2 To lr Step 1
      j = j + 1
      o(j, 1) = a(i, 1)
      o(j, 2) = a(i, c)
      o(j, 3) = a(1, c)
    Next i
  Next c
  .Cells(1, lc + 3).Value = "Mat No"
  .Cells(2, lc + 3).Resize(n, 3).Value = o
  .Columns(lc + 3).Resize(, 3).AutoFit
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.

 

[charpotro]

Thanks hiker95, the macro was very useful... it is working now... again thanks for taking the time to help out...

 

[hiker95]

charpotro,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.