Creating Duplicate Rows

[tryingmybest418]

Hi all,

I have a worksheet where each row represents a location. Column C lists all of the employees at that location separated by carriage returns.

Is it possible for the sheet to split out the employees and display individual lines for each employee?

Location ID	Location	Employees	Manager	Budget
100	Chicago	Alex Anderson Bob Barney Chris Conners	Mr. Manager	200,000
200	Atlanta	Dan Davidson Emmit Erickson Fran Fredrickson	Ms. Supervisor	300,000

<tbody>
</tbody>

Location ID	Location	Employee	Manager	Budget
100	Chicago	Alex Anderson	Mr. Manager	200,000
100	Chicago	Bob Barney	Mr. Manager	200,000
100	Chicago	Chris Conners	Mr. Manager	200,000
200	Atlanta	Dan Davidson	Ms. Supervisor	300,000
200	Atlanta	Emmit Erickson	Ms. Supervisor	300,000
200	Atlanta	Fran Fredrickson	Ms. Supervisor	300,000

<tbody>
</tbody>

Thanks!

 

[footoo]

Sub Split_Cr()
Dim rng As Range, cel As Range, cr%
Set rng = Range([C2], Cells(Rows.Count, "C").End(xlUp))
For Each cel In rng
    cr = Len(cel) - Len(Replace(cel, vbLf, ""))
    If cr > 0 Then
        cel(2).Resize(cr).EntireRow.Insert
        cel.Resize(cr + 1) = WorksheetFunction.Transpose(Split(cel, vbLf))
    End If
Next
Set rng = Range([A2], Cells(Rows.Count, "C").End(xlUp)(1, 3))
rng.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
rng = rng.Value
End Sub

 

[tryingmybest418]

This is great, thank you.

I made a couple adjustments, and it's working better, but there's still an issue:

My worksheet isn't exactly like the example, I have columns through J, so I changed the Set rng line to (1, 8)

I also moved the entire rng portion inside the If statement.

It seems to be close, but i'm getting duplicates- see my new code and example below:

Location ID	Location	Employees	Manager	Budget
100	Chicago	Alex Anderson Bob Barney Chris Conners	Mr. Manager	200,000
200	Atlanta	Dan Davidson Emmit Erickson Fran Fredrickson	Ms. Supervisor	300,000

<tbody>
</tbody>

Location ID	Location	Employee	Manager	Budget
100	Chicago	Alex Anderson	Mr. Manager	200,000
100	Chicago	Alex Anderson	Mr. Manager	200,000
100	Chicago	Bob Barney	Mr. Manager	200,000
100	Chicago	Bob Barney	Mr. Manager	200,000
100	Chicago	Chris Conners	Mr. Manager	200,000
100	Chicago	Chris Conners	Mr. Manager	200,000

<tbody>
</tbody>

200

Atlanta

Dan Davidson

Ms. Supervisor

300,000

<tbody>
</tbody>

200

Atlanta

Dan Davidson

Ms. Supervisor

300,000

<tbody>
</tbody>

etc.

Sub Split_Cr()
Dim rng As Range, cel As Range, cr%
Set rng = Range([C2], Cells(Rows.Count, "C").End(xlUp))
For Each cel In rng
    cr = Len(cel) - Len(Replace(cel, vbLf, ""))
    If cr > 0 Then
        cel(2).Resize(cr).EntireRow.Insert
        cel.Resize(cr + 1) = WorksheetFunction.Transpose(Split(cel, vbLf))
    
    Set rng = Range([A2], Cells(Rows.Count, "C").End(xlUp)(1, 8))
rng.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
rng = rng.Value
    
    End If


Next


End Sub

Sub Split_Cr()
Dim rng As Range, cel As Range, cr%
Set rng = Range([C2], Cells(Rows.Count, "C").End(xlUp))
For Each cel In rng
    cr = Len(cel) - Len(Replace(cel, vbLf, ""))
    If cr > 0 Then
        cel(2).Resize(cr).EntireRow.Insert
        cel.Resize(cr + 1) = WorksheetFunction.Transpose(Split(cel, vbLf))
    End If
Next
Set rng = Range([A2], Cells(Rows.Count, "C").End(xlUp)(1, 3))
rng.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
rng = rng.Value
End Sub

 

[footoo]

Don't do this : "I also moved the entire rng portion inside the If statement."

Sub Split_Cr()
Dim rng As Range, cel As Range, cr%
Set rng = Range([C2], Cells(Rows.Count, "C").End(xlUp))
For Each cel In rng
    cr = Len(cel) - Len(Replace(cel, vbLf, ""))
    If cr > 0 Then
        cel(2).Resize(cr).EntireRow.Insert
        cel.Resize(cr + 1) = WorksheetFunction.Transpose(Split(cel, vbLf))
    End If
Next
Set rng = Range([A2], Cells(Rows.Count, "C").End(xlUp)(1, [COLOR=#ff0000]8[/COLOR]))
rng.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
rng = rng.Value
End Sub