Transforming a weird data layout structure

[jpchen0321]

Hi,

Using VBA...

I have sets of data that is represented in this form (comma represents cell separation):

1, data1a, data1b, data1c
2, data2a, data2b
3, data3a, data3b, data3c, data3d

How can I transform that data into the following form:

1, data1a
1, data1b
1, data1c
2, data2a
2, data2b
3, data3a
3, data3b
3, data3c
3, data3d

Thanks.

 

[hiker95]

jpchen0321,

Welcome to the MrExcel forum.


Sample data in worksheet Sheet1:

Excel Workbook
	A	B	C	D	E
1	1	data1a	data1b	data1c
2	2	data2a	data2b
3	3	data3a	data3b	data3c	data3d
4
Sheet1

After the macro in a new worksheet Results:

Excel Workbook
	A	B
1	1	data1a
2	1	data1b
3	1	data1c
4	2	data2a
5	2	data2b
6	3	data3a
7	3	data3b
8	3	data3c
9	3	data3d
10
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, 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, 02/14/2011
' http://www.mrexcel.com/forum/showthread.php?t=529103
Dim w1 As Worksheet, wR As Worksheet
Dim LR As Long, a As Long, LC As Long, n As Long, NR As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
LR = w1.Cells(Rows.Count, 1).End(xlUp).Row
NR = 1
For a = 1 To LR Step 1
  LC = w1.Cells(a, Columns.Count).End(xlToLeft).Column
  n = LC - 1
  wR.Range("A" & NR).Resize(n) = w1.Range("A" & a)
  wR.Range("B" & NR).Resize(n) = Application.Transpose(w1.Range("B" & a).Resize(, n))
  NR = wR.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Next a
wR.UsedRange.Columns.AutoFit
wR.Activate
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[jpchen0321]

Thank you so much. This worked very well!

Greatly appreciated!