Splitting Cells Into Rows,Commas, Preserve uique ID

[malmbrus]

<!--[if gte mso 9]><xml> <o:OfficeDocumentSettings> <o:AllowPNG/> </o:OfficeDocumentSettings> </xml><![endif]--> So I have a large data set with numerous zip codes per cell and I need to split the cells into individual rows but preserve the organization each zip codes comes from. The picture link attached is 'what I have' and 'what I want' in excel. If someone could help me out a bit with a script that run this for multiple records it would be much appreciated and I will send good vibes to you. Thanks so much for you help, I really appreciate it!

 

[hiker95]

malmbrus,

Welcome to the MrExcel forum.

Sample raw data:

Excel 2007
	A	B	C
1
2
3	437	Save the Prarie Society	60154, 50526, 60546, 60558
4	425	Oakbrook Terrace Park District	60126, 60181, 60148, 60131
5
6
7
8
9
10
11
Sheet1

After the macro:

Excel 2007
	A	B	C
1
2
3	437	Save the Prarie Society	60154
4	437	Save the Prarie Society	50526
5	437	Save the Prarie Society	60546
6	437	Save the Prarie Society	60558
7	425	Oakbrook Terrace Park District	60126
8	425	Oakbrook Terrace Park District	60181
9	425	Oakbrook Terrace Park District	60148
10	425	Oakbrook Terrace Park District	60131
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, 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, 04/13/2013
' http://www.mrexcel.com/forum/excel-questions/696779-splitting-cells-into-rows-commas-preserve-uique-id.html
Dim r As Long, lr As Long, s, n As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 3 Step -1
  If InStr(Cells(r, 3), ", ") > 0 Then
    s = Split(Cells(r, 3), ", ")
    Rows(r + 1).Resize(UBound(s)).Insert
    Cells(r + 1, 1).Resize(UBound(s), 2).Value = Cells(r, 1).Resize(, 2).Value
    Cells(r, 3).Resize(UBound(s) + 1).Value = Application.Transpose(s)
  End If
Next r
Cells.EntireColumn.AutoFit
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.