Hi,
I would like to know how I can duplicate a row if a cell in a particular column has multiple values separated by a carriage return (or maybe its an endline not sure). My data looks something like this:
uniquetext_A text1
text2
uniquetext_B text1
uniquetext_C text1
text2
text3
and the result would ideally be:
uniquetext_A text1
uniquetext_A text2
uniquetext_B text1
uniquetext_C text1
uniquetext_C text2
uniquetext_C text3
I've already tried this:
And I'm having partial success, with problems though.
Here are my before-after macro pictures of the sheet, and also a link to the original file.
Original: https://drive.google.com/open?id=0B661J_9je5FVRkYyTU9XLV9HQ2M
Post-Macro: https://drive.google.com/open?id=0B661J_9je5FVYWdRY29IWGZxd28
Original File: https://drive.google.com/open?id=0B661J_9je5FVM21raWpuTUI5STA
Regards!
I would like to know how I can duplicate a row if a cell in a particular column has multiple values separated by a carriage return (or maybe its an endline not sure). My data looks something like this:
uniquetext_A text1
text2
uniquetext_B text1
uniquetext_C text1
text2
text3
and the result would ideally be:
uniquetext_A text1
uniquetext_A text2
uniquetext_B text1
uniquetext_C text1
uniquetext_C text2
uniquetext_C text3
I've already tried this:
Code:
Sub SplitCarriages()
Dim mySplit() As String
Dim i As Long, txtCount As Long
Dim lastRow As Long, recRow As Long
Dim searchCol As String
Dim sourceWS As Worksheet, dumpWS As Worksheet
'Which worksheet as we getting data from?
Set sourceWS = Worksheets("Sheet1")
'Which worksheet are we putting data in?
Set dumpWS = Worksheets("Sheet2")
'Which column has carraige returns?
searchCol = "B"
Application.ScreenUpdating = False
dumpWS.Select
recRow = 0
With sourceWS
lastRow = .Cells(.Rows.Count, searchCol).End(xlUp).Row
'Starting at row 1, presumably
For i = 1 To lastRow
mySplit = Split(.Cells(i, searchCol), Chr(10))
For txtCount = LBound(mySplit) To UBound(mySplit)
recRow = recRow + 1
'Copy whole row
.Cells(i, 1).EntireRow.Copy Cells(recRow, 1)
'Place single line of text
Cells(recRow, searchCol).Value = mySplit(txtCount)
Next txtCount
Next i
End With
Application.ScreenUpdating = True
End Sub
And I'm having partial success, with problems though.
Here are my before-after macro pictures of the sheet, and also a link to the original file.
Original: https://drive.google.com/open?id=0B661J_9je5FVRkYyTU9XLV9HQ2M
Post-Macro: https://drive.google.com/open?id=0B661J_9je5FVYWdRY29IWGZxd28
Original File: https://drive.google.com/open?id=0B661J_9je5FVM21raWpuTUI5STA
Regards!