IF Loop to Separate Names

[contra76]

Hi,

I have a deadline to meet and need to put this together quick.

Column A has a list of serial numbers.

Next to every serial number (Column B), are several names separated by semi-colons.

Example:
456789 john; mary; bob
343400 gary, frank
230200 fisher; john; harry; ron
545777 john

I would like to make a macro that takes the names in column B and separates them line by line. There will always be a semicolon separating the names.

Result:
456789 john
456789 mary
456789 bob
343400 gary
343400 frank
etc

Please help? I don't know where to start.
Thanks!

[JBeaucaire]

'ROWS TO COLUMNS
Here's a macro for expanding rows of data to multiple rows parsing out the delimited values in one column while duplicating all the others.

Rows to Columns - Part 2

Just edit the Col = 3 code to Col = 2 and run it on a copy of your data, should do what you want. There's a sample workbook too you could drop your data into and test it out.

[contra76]

Thanks for the quick reply!

I got an error trying to access the site though. Can you please post another link?

I looked into the URL and played around with it to get it to work

https://sites.google.com/a/madrocket...ows-to-columns

[JBeaucaire]

Thanks for the quick reply!

I got an error trying to access the site though. Can you please post another link?

I looked into the URL and played around with it to get it to work

https://sites.google.com/a/madrocket...ows-to-columns

That's the correct link, I clicked it in your post above and in mine and both work fine.

[contra76]

Works like a charm.

Hate to be difficult but what if there are semicolons at the end sometimes?

For example sometimes it would look like:
456789 john; mary; bob;
343400 gary, frank;
230200 fisher; john; harry; ron;
545777 john

So the first three rows would make an extra row which would be blank but the last would not.

Code I'm using:

Option Explicit

Sub ParseByColumn()

'Split delimited column data into separate rows
'duplicate other column values as needed
Dim LR As Long, Rw As Long, Col As Long, MyVal As Long
Dim MyArr As Variant, LC As Long
Dim Titles As Long
'Application.ScreenUpdating = False

Titles = 8 - MsgBox("Does the data have titles in row1?", vbYesNo, "Include row1?")

'set column to evaluate:  1="A", 2="B", 3="C", etc...
    Col = 5

LR = Range("A" & Rows.Count).End(xlUp).Row

For Rw = LR To Titles Step -1
  'separated by commas
    If InStr(Cells(Rw, Col), ",") > 0 Then
       MyArr = Split(Cells(Rw, Col), ",")
  'separated by semicolons
    ElseIf InStr(Cells(Rw, Col), ";") > 0 Then
        MyArr = Split(Cells(Rw, Col), ";")

    End If
        
    Rows(Rw).Copy
    Rows(Rw + 1 & ":" & Rw + UBound(MyArr)).Insert xlShiftDown
    Cells(Rw, Col).Resize(UBound(MyArr) + 1).Value = _
        Application.WorksheetFunction.Transpose(MyArr)
Next Rw

'Cleanup appearance
    Cells.Columns.AutoFit
    Cells.Rows.AutoFit
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[JBeaucaire]

The code has a series of "parsing" tests, the last one being just "spaces". With your data, I'd do a search/replace on that column and just remove all the semicolons.

[JBeaucaire]

If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.