New row for comma-separated values

[Gain]

Hi,

A sample spreadsheet of what I have is provided below:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]ID NUMBER[/TD]
[TD]CHEMICAL NAME[/TD]
[TD]HAZARD[/TD]
[TD]VALUE[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]chemical a[/TD]
[TD]carcinogen[/TD]
[TD]recognized[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]chemical a[/TD]
[TD]Respiratory, blood, kidney[/TD]
[TD]suspected[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]chemical b[/TD]
[TD]immunotoxic, carcinogen[/TD]
[TD]suspected[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]chemical c[/TD]
[TD]liver, carcinogen[/TD]
[TD]recognized[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]chemical d[/TD]
[TD]kidney[/TD]
[TD]recognized[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]chemical d[/TD]
[TD]neurotoxic[/TD]
[TD]suspected[/TD]
[/TR]
</tbody>[/TABLE]

Only the words 'recognized' or 'suspected' can be entered into the VALUE column and hazards that are either recognized or suspected of being caused by that chemical in that row are listed in the HAZARD column. I need to have a separate entry for each hazard, like the following table, using the same chemicals as above:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]CAS NUMBER[/TD]
[TD]CHEMICAL NAME[/TD]
[TD]HAZARD[/TD]
[TD]VALUE[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]chemical a[/TD]
[TD]carcinogen[/TD]
[TD]recognized[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]chemical a[/TD]
[TD]respiratory[/TD]
[TD]suspected[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]chemical a[/TD]
[TD]blood[/TD]
[TD]suspected[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]chemical a[/TD]
[TD]kidney[/TD]
[TD]suspected[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]chemical b[/TD]
[TD]immunotoxic[/TD]
[TD]suspected[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]chemical b[/TD]
[TD]carcinogen[/TD]
[TD]suspected[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]chemical c[/TD]
[TD]liver[/TD]
[TD]recognized[/TD]
[/TR]
[TR]
[TD]3 [/TD]
[TD]chemical c[/TD]
[TD]carcinogen[/TD]
[TD]recognized[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]chemical d [/TD]
[TD]kidney[/TD]
[TD]recognized[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]chemical d[/TD]
[TD]neurotoxic[/TD]
[TD]suspected[/TD]
[/TR]
</tbody>[/TABLE]

How can I create a new row for each comma-separated hazard?

Thank you in advance

 

[hiker95]

Gain,


Sample raw data:

Excel Workbook
	A	B	C	D
1	ID NUMBER	CHEMICAL NAME	HAZARD	VALUE
2	1	chemical a	carcinogen	recognized
3	1	chemical a	Respiratory, blood, kidney	suspected
4	2	chemical b	immunotoxic, carcinogen	suspected
5	3	chemical c	liver, carcinogen	recognized
6	4	chemical d	kidney	recognized
7	4	chemical d	neurotoxic	suspected
8
9
10
11
12
Sheet1

After the macro:

Excel Workbook
	A	B	C	D
1	ID NUMBER	CHEMICAL NAME	HAZARD	VALUE
2	1	chemical a	carcinogen	recognized
3	1	chemical a	Respiratory	suspected
4	1	chemical a	blood	suspected
5	1	chemical a	kidney	suspected
6	2	chemical b	immunotoxic	suspected
7	2	chemical b	carcinogen	suspected
8	3	chemical c	liver	recognized
9	3	chemical c	carcinogen	recognized
10	4	chemical d	kidney	recognized
11	4	chemical d	neurotoxic	suspected
12
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, 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, 06/20/2012
' http://www.mrexcel.com/forum/showthread.php?641962-New-row-for-comma-separated-values
Dim lr As Long, r As Long, Sp
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 2 Step -1
  If InStr(Cells(r, 3), ",") > 0 Then
    Sp = Split(Cells(r, 3), ", ")
    Rows(r + 1).Resize(UBound(Sp)).Insert
    Rows(r + 1).Resize(UBound(Sp)).Value = Rows(r).Value
    Cells(r, 3).Resize(UBound(Sp) + 1).Value = Application.Transpose(Sp)
  End If
Next r
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.

 

[Gain]

Thank you, it worked

 

[hiker95]

Gain,

You are very welcome. Glad I could help.

Thanks for the feedback.