vba or forumula to transpose

[Access Beginner]

Hi

Sample data

[TABLE="width: 332"]
<colgroup><col width="243" style="width: 182pt; mso-width-source: userset; mso-width-alt: 6220;"><colgroup><col width="200" style="width: 150pt; mso-width-source: userset; mso-width-alt: 5120;"><tbody>[TR]
[TD="width: 243, bgcolor: transparent"]Column A
[/TD]
[TD="width: 200, bgcolor: transparent"]Column B[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item1[/TD]
[TD="bgcolor: transparent"]aaa,bbb,ccc[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item2[/TD]
[TD="bgcolor: transparent"]ddd,eee,fff,%7y
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"][/TD]
[TD="bgcolor: transparent"][/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent"]ggg,hhh,iii,jjj,lll,mmm,nnn,123

[/TD]
[/TR]
</tbody>[/TABLE]
I have in column A a list of items (39 items in total) after each item there is a blank row, in column B is 3 letter codes, which can be made up of alpha, numeric and characters. There can be 2 codes or up to 20 codes. Desired outcome below:

[TABLE="width: 332"]
<colgroup><col width="243" style="width: 182pt; mso-width-source: userset; mso-width-alt: 6220;"> <col width="200" style="width: 150pt; mso-width-source: userset; mso-width-alt: 5120;"> <tbody>[TR]
[TD="width: 243, bgcolor: transparent"]Column A[/TD]
[TD="width: 200, bgcolor: transparent"]Column B[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item1[/TD]
[TD="bgcolor: transparent"]aaa[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item1[/TD]
[TD="bgcolor: transparent"]bbb[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item1[/TD]
[TD="bgcolor: transparent"]ccc[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item2[/TD]
[TD="bgcolor: transparent"]ddd[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item2[/TD]
[TD="bgcolor: transparent"]eee[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item2[/TD]
[TD="bgcolor: transparent"]fff[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item2[/TD]
[TD="bgcolor: transparent"]%7y[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent"]ggg[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent"]hhh[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent"]iii[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent"]jjj[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent"]lll[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent"]mmm
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent"]nnn[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Item3[/TD]
[TD="bgcolor: transparent, align: right"]123[/TD]
[/TR]
</tbody>[/TABLE]

 

[Blade Hunter]

Sub TransposeStuff()
Dim X As Long
Range("D1:E1").Formula = Array("Item", "Type")
For X = 1 To Range("A" & Rows.Count).End(xlUp).Row
    For Each iItem In Split(Range("B" & X).Text, ",")
        Range("D" & Range("D" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = Range("A" & X).Text
        Range("E" & Range("E" & Rows.Count).End(xlUp).Row).Offset(1, 0).Formula = iItem
    Next
Next
End Sub

 

[hiker95]

Access Beginner,

Sample raw data in worksheet Sheet1 (if the sheet name is not correct, it can be adjusted in the macro):

Excel 2007
	A	B
1	Item1	aaa,bbb,ccc
2
3	Item2	ddd,eee,fff,%7y
4
5	Item3	ggg,hhh,iii,jjj,lll,mmm,nnn,123
6
7
8
9
10
11
12
13
14
15
16
Sheet1

After the macro:

Excel 2007
	A	B
1	Item1	aaa
2	Item1	bbb
3	Item1	ccc
4	Item2	ddd
5	Item2	eee
6	Item2	fff
7	Item2	%7y
8	Item3	ggg
9	Item3	hhh
10	Item3	iii
11	Item3	jjj
12	Item3	lll
13	Item3	mmm
14	Item3	nnn
15	Item3	123
16
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 TransposeData()
' hiker95, 01/14/2015, ME829096
Dim r As Long, lr As Long, s, i As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = lr To 1 Step -2
    If InStr(.Cells(r, 2), ",") Then
      s = Split(.Cells(r, 2), ",")
      .Rows(r + 1).Resize(UBound(s)).Insert
      .Cells(r + 1, 1).Resize(UBound(s)).Value = .Cells(r, 1).Value
      .Cells(r, 2).Resize(UBound(s) + 1).Value = Application.Transpose(s)
    End If
  Next r
  On Error Resume Next
 .Range("A1", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
  .Columns("A:B").AutoFit
End With
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 TransposeData macro.

 

[Access Beginner]

Brillant! Worked perfectly!

Thanks Blade

Cheers
Haydn

 

[Access Beginner]

Thanks you you as well hiker95, your code worked out great as well

Cheers
Haydn

 

[hiker95]

Access Beginner,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.