Split cell information into list

[Marsh205]

Hello,

I have a cell that contains various number of text separated by commas. I would like for the information separated by commas to go into a list below the first item in the cell. Here is an example.

Current Data

ID Number	First Name	Last Name	Involvement
58475	Kate	Smith	Law Review,Active Minds,Soccer, Accounting Club
786543	Sam	King	Chinese Studies,Boxing,
873423	Kim	Shaw	*******, Carswell, Tennis, Zeta, Golf, Presidential Scholar, Archery, Women in Science, Concert Choir

<tbody>
</tbody>

This what I want it to look like.

58475	Kate	Smith	Law Review
58475			Active Minds
58475			Soccer
58475			Accounting Club

<tbody>
</tbody>

I am not well versed on the use of Macros. So if you can explain it like I am 5 that would be great. I truly appreciate your help as I have over 5,000 rows of data.

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub SplitCellInfoIntoList()
  Dim R As Long, Idx As Long, ItemCount As Long, ResultCount As Long
  Dim Data As Variant, Result As Variant, Categories() As String
  ItemCount = Evaluate("SUM(LEN(TRIM(D2:D4))-LEN(SUBSTITUTE(TRIM(D2:D4),"","",""""))+(RIGHT(TRIM(D2:D4))<>"",""))")
  Data = Range("A2", Cells(Rows.Count, "D").End(xlUp))
  ReDim Result(1 To ItemCount, 1 To UBound(Data, 2))
  ResultCount = 1
  For R = 1 To UBound(Data)
    If Right(Trim(Data(R, 4)), 1) = "," Then Data(R, 4) = Left(Data(R, 4), InStrRev(Data(R, 4), ",") - 1)
    Categories = Split(Data(R, 4), ",")
    Result(ResultCount, 2) = Data(R, 2)
    Result(ResultCount, 3) = Data(R, 3)
    For Idx = 0 To UBound(Categories)
      Result(ResultCount + Idx, 1) = Data(R, 1)
      Result(ResultCount + Idx, 4) = Categories(Idx)
    Next
    ResultCount = ResultCount + UBound(Categories) + 1
  Next
  Range("A2").Resize(UBound(Result), 4) = Result
End Sub[/td]
[/tr]
[/table]

HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (SplitCellInfoIntoList) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

 

[hiker95]

Marsh205,

Welcome to the MrExcel forum.

Here is another macro solution for you to consider that is based on your flat text display in the active worksheet in range A1:D4.

The results will be in range A1:D16.


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 Split_Cell_Info_Into_List()
' hiker95, 08/28/2017, ME1020696
Dim r As Long, lr As Long, s, i As Long, Addr As String
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells(Rows.Count, 4).End(xlUp).Row
  For r = lr To 2 Step -1
    If InStr(.Cells(r, 4), ",") Then
      s = Split(.Cells(r, 4), ",")
      .Rows(r + 1).Resize(UBound(s)).Insert
      .Cells(r, 4).Resize(UBound(s) + 1) = Application.Transpose(s)
      .Cells(r, 1).Resize(UBound(s) + 1) = .Cells(r, 1).Value
    End If
  Next r
  Addr = "D2:D" & .Cells(Rows.Count, "A").End(xlUp).Row
  Range(Addr) = Evaluate("IF(" & Addr & "="""","""",TRIM(" & Addr & "))")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  On Error Resume Next
  Range("D2:D" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
  .Columns(4).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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the Split_Cell_Info_Into_List macro.

 

[Marsh205]

Marsh205,

Welcome to the MrExcel forum.

Here is another macro solution for you to consider that is based on your flat text display in the active worksheet in range A1:D4.

The results will be in range A1:D16.


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 Split_Cell_Info_Into_List()
' hiker95, 08/28/2017, ME1020696
Dim r As Long, lr As Long, s, i As Long, Addr As String
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells(Rows.Count, 4).End(xlUp).Row
  For r = lr To 2 Step -1
    If InStr(.Cells(r, 4), ",") Then
      s = Split(.Cells(r, 4), ",")
      .Rows(r + 1).Resize(UBound(s)).Insert
      .Cells(r, 4).Resize(UBound(s) + 1) = Application.Transpose(s)
      .Cells(r, 1).Resize(UBound(s) + 1) = .Cells(r, 1).Value
    End If
  Next r
  Addr = "D2:D" & .Cells(Rows.Count, "A").End(xlUp).Row
  Range(Addr) = Evaluate("IF(" & Addr & "="""","""",TRIM(" & Addr & "))")
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  On Error Resume Next
  Range("D2:D" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
  .Columns(4).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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the Split_Cell_Info_Into_List macro.

Thank you so much! The instructions are very clear but it is still not working when I use Alt F8. I saved it with the .xlsm extension, closed it and then re-opened. It did not ask me if I wanted to enable with macros. I also double checked my settings and I have all macros enabled. Any idea?

 

[Rick Rothstein]

Thank you so much! The instructions are very clear but it is still not working when I use Alt F8. I saved it with the .xlsm extension, closed it and then re-opened. It did not ask me if I wanted to enable with macros. I also double checked my settings and I have all macros enabled. Any idea?

Close and then reopen the workbook and go into the VB editor (press ALT+F11) and look on the left side for the Project-VBAProject subwindow... do you see an item in it labeled "Modules" (it will be under the list sheet names). If yes and if it has a plus sign in front of it, click the plus sign... then double click the item named Module1 (I am assuming you only have one module... if you have more, then click the last module name in the list)... is the Split_Cell_Info_Into_List subroutine that hiker95 posted listed there? If not, then you did not save the workbook with the macro in it correctly. If, on the other hand, the code is there, then I am not sure what to tell you... it should have been in the ALT+F8 listing when pressed from the worksheet.

As an aside, did you get a chance to try the macro I posted in Message #2 yet. I am not sure if you will run into the same problem that you did with hiker95's code or not, but I did not want you to ignore what I posted just because other code was posted by someone else later on.

 

[hiker95]

Marsh205,

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?

 

[Marsh205]

Close and then reopen the workbook and go into the VB editor (press ALT+F11) and look on the left side for the Project-VBAProject subwindow... do you see an item in it labeled "Modules" (it will be under the list sheet names). If yes and if it has a plus sign in front of it, click the plus sign... then double click the item named Module1 (I am assuming you only have one module... if you have more, then click the last module name in the list)... is the Split_Cell_Info_Into_List subroutine that hiker95 posted listed there? If not, then you did not save the workbook with the macro in it correctly. If, on the other hand, the code is there, then I am not sure what to tell you... it should have been in the ALT+F8 listing when pressed from the worksheet.

As an aside, did you get a chance to try the macro I posted in Message [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2 [/URL] yet. I am not sure if you will run into the same problem that you did with hiker95's code or not, but I did not want you to ignore what I posted just because other code was posted by someone else later on.

I did try the code in #2 and I received a Run-time error '9': Subscript out of range error message. I do see the module and the code is there. However when I press Alt F8 it does not do anything with hiker95's code.

 

[Marsh205]

I am using Microsoft Office Professional Plus 2016. I am on a PC.

 

[Marsh205]

When I press ALT Q I receive "This command will stop the debugger." Do I say okay?

 

[Rick Rothstein]

I did try the code in #2 and I received a Run-time error '9': Subscript out of range error message.

What line of code is highlighted when you get that error message?