Special transpose

[natkatten]

Hi VBA experts


I have a table with an identifier in column A and values in columns B to Z.


The structure is like this:
[TABLE="width: 500"]
<tbody>[TR]
[TD]IdentifierA[/TD]
[TD]value1[/TD]
[TD]value2[/TD]
[TD]value3[/TD]
[TD]value4[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]IdentifierB[/TD]
[TD]value5[/TD]
[TD]value6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]IdentifierC[/TD]
[TD]value7[/TD]
[TD]value8[/TD]
[TD]value9[/TD]
[TD]value10[/TD]
[TD]value11[/TD]
[TD]value12[/TD]
[/TR]
[TR]
[TD]IdentifierD[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]IdentifierE[/TD]
[TD]value13[/TD]
[TD]value14[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


There is 3.000 rows of data. As you can see some of the identifiers have no values.


On another sheet I need the following table to be generated in this format (two columns):


IdentifierA Value1
IdentifierA Value2
IdentifierA Value3
IdentifierA Value4
IdentifierB Value5
IdentifierB Value6
IdentifierC Value7
IdentifierC Value8
IdentifierC Value9
IdentifierC Value10
IdentifierC Value11
IdentifierC Value12
IdentifierE Value13
IdentifierE Value14


Note that as IdentifierD has no values it shouldn't be in the new table.


Your help will be highly valued.

 

[hiker95]

natkatten,

Welcome to the MrExcel forum.


Sample raw data in worksheet Sheet1:

Excel Workbook
	A	B	C	D	E	F	G	H
1	IdentifierA	value1	value2	value3	value4
2	IdentifierB	value5	value6
3	IdentifierC	value7	value8	value9	value10	value11	value12
4	IdentifierD
5	IdentifierE	value13	value14
6
Sheet1

After the macro in a new worksheet Results:

Excel Workbook
	A	B
1	IdentifierA	value1
2	IdentifierA	value2
3	IdentifierA	value3
4	IdentifierA	value4
5	IdentifierB	value5
6	IdentifierB	value6
7	IdentifierC	value7
8	IdentifierC	value8
9	IdentifierC	value9
10	IdentifierC	value10
11	IdentifierC	value11
12	IdentifierC	value12
13	IdentifierE	value13
14	IdentifierE	value14
15
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, 10/06/2012
' http://www.mrexcel.com/forum/excel-questions/663115-special-transpose.html
Dim w1 As Worksheet, wR As Worksheet
Dim i As Variant, o As Variant
Dim r As Long, lr As Long, c As Long, lc As Long, n As Long, nr As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
lr = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
lc = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
i = w1.Range(w1.Cells(1, 1), w1.Cells(lr, lc))
n = Application.CountA(w1.Range(w1.Cells(1, 2), w1.Cells(lr, lc)))
ReDim o(1 To n, 1 To 2)
nr = 0
For r = 1 To UBound(i, 1)
  For c = 2 To UBound(i, 2)
    If i(r, c) <> "" Then
      nr = nr + 1
      o(nr, 1) = i(r, 1)
      o(nr, 2) = i(r, c)
    End If
  Next c
Next r
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
wR.Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
wR.Cells.EntireColumn.AutoFit
wR.Activate
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


Then run the ReorgData macro.

 

[natkatten]

Hi hiker95

Thanks a lot. I really appreciate this. It worked really well after I renamed my sheet with the source data.

Thanks again from natkatten, Denmark

 

[hiker95]

natkatten,

You are very welcome. Glad I could help.

Thanks for the feedback.

Come back anytime.