Hi All,
I have a file that needs to delimit the data from two columns. I have an example below:
It should be like this:
I have a script here but it only delimits one column.
Thank you very much!
I have a file that needs to delimit the data from two columns. I have an example below:
| Name | Title1 | Title2 |
| Bob | Book1; Book2 | The Notebook; Greenhouse |
| Alex | Book1 | One Summer |
| Sally | Book2; Book3 | The Last Song; What's your name? |
It should be like this:
| Name | Title1 | Title2 |
| Bob | Book1 | The Notebook |
| Bob | Book2 | Greenhouse |
| Alex | Book1 | One Summer |
| Sally | Book2 | The Last Song |
| Sally | Book3 | What's your name? |
I have a script here but it only delimits one column.
Code:
Sub Parsing()
'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, SplitIt As Boolean
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 = 3
LR = Range("A" & Rows.Count).End(xlUp).Row
For Rw = LR To Titles Step -1
'separated by semicolons
If InStr(Cells(Rw, Col), ";") > 0 Then
MyArr = Split(Cells(Rw, Col), ";")
SplitIt = True
End If
If SplitIt = True Then
Rows(Rw).Copy
Rows(Rw + 1 & ":" & Rw + UBound(MyArr)).Insert xlShiftDown
Cells(Rw, Col).Resize(UBound(MyArr) + 1).Value = _
Application.WorksheetFunction.Transpose(MyArr)
End If
SplitIt = False
Next Rw
'Cleanup appearance
Cells.Columns.AutoFit
Cells.Rows.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub