How do I split information in one column and duplicate the information in other columns into new rows?

[dougebowl]

Okay......Not sure this can be done in Excel or not, but, here goes. I receive files which contains Observations for loans. Some loans may have a single observation and others could have multiple observations. For those with multiple observations, they are usually separated in the cell using Alt-Enter a couple of times to create spacing between the observations. I need to be able to split the multiple observations into different rows and copy the information which appears in the corresponding columns for that loan. I have included a example of the input and desired outcome below. Can this be done in Excel?

	Input
	A	B	C	D	E	F	G	H
1	AOI	MLT	Insurer	Observation	Observation Category	Other sub	Acct #	Name
2	Claims	NOV 2012	FHA	Observation 1 Observation 2			123456	This Guy
3	Claims	NOV 2012	FHA	Observation 1			654321	That Girl
4	Claims	NOV 2012	FHA	Observation 1 Observation 2 Observation 3			987654	This Girl
5	Claims	NOV 2012	FHA	Observation 1			456789	That Guy

<tbody>
</tbody>

	Desired Outcome
	A	B	C	D	E	F	G	H
1	AOI	MLT	Insurer	Observation	Observation Category	Other sub	Acct #	Name
2	Claims	NOV 2012	FHA	Observation 1			123456	This Guy
3	Claims	NOV 2012	FHA	Observation 2			123456	This Guy
4	Claims	NOV 2012	FHA	Observation 1			654321	That Girl
5	Claims	NOV 2012	FHA	Observation 1			987654	This Girl
6	Claims	NOV 2012	FHA	Observation 2			987654	This Girl
7	Claims	NOV 2012	FHA	Observation 3			987654	This Girl
8	Claims	NOV 2012	FHA	Observation 1			456789	That Guy

<tbody>
</tbody>

 

[Weazel]

maybe try...

Select A2:H8
hit F5 and click special
select blanks
hit F2 to put the cell in edit mode type = and hit the up arrow once based on your example this would be E1.
then hold down the Control key and hit Enter.
you'd then need to delete the info in E and F

its a little tricky but its quick

 

[Marcelo Branco]

Maybe this macro

Assumes
input sheet --> Sheet1 (data in columns A - H, headers in row 1)
outcome sheet --> Sheet2

Sub aTest()
    Dim lastRow As Long, s As Variant, i As Long, j As Long, lin As Long
    
    With Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lin = 1
        For i = 2 To lastRow
            s = Split(.Cells(i, 4), Chr(10))
            For j = LBound(s) To UBound(s)
                lin = lin + 1
                Sheets("Sheet2").Range("A" & lin & ":C" & lin) = .Range("A" & i & ":C" & i).Value
                Sheets("Sheet2").Range("D" & lin) = s(j)
                Sheets("Sheet2").Range("E" & lin & ":H" & lin) = .Range("E" & i & ":H" & i).Value
            Next j
        Next i
        
         Sheets("Sheet2").Range("A1:H1") = .Range("A1:H1").Value
         Sheets("Sheet2").Columns("A:H").AutoFit
    End With
   
End Sub

M.

 

[dougebowl]

Maybe this macro

Assumes
input sheet --> Sheet1 (data in columns A - H, headers in row 1)
outcome sheet --> Sheet2

Sub aTest()
    Dim lastRow As Long, s As Variant, i As Long, j As Long, lin As Long
    
    With Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lin = 1
        For i = 2 To lastRow
            s = Split(.Cells(i, 4), Chr(10))
            For j = LBound(s) To UBound(s)
                lin = lin + 1
                Sheets("Sheet2").Range("A" & lin & ":C" & lin) = .Range("A" & i & ":C" & i).Value
                Sheets("Sheet2").Range("D" & lin) = s(j)
                Sheets("Sheet2").Range("E" & lin & ":H" & lin) = .Range("E" & i & ":H" & i).Value
            Next j
        Next i
        
         Sheets("Sheet2").Range("A1:H1") = .Range("A1:H1").Value
         Sheets("Sheet2").Columns("A:H").AutoFit
    End With
   
End Sub

M.

Thanks for the help!!!! This worked great. It does add a row for the blank space between the multiple observations. Can additional code be added to remove the row if the observation column is blank?

 

[Marcelo Branco]

Not sure if i understand what you want

This?

Sub aTest()
    Dim lastRow As Long, s As Variant, i As Long, j As Long, lin As Long
    
    With Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        lin = 1
        For i = 2 To lastRow
            s = Split(.Cells(i, 4), Chr(10))
            For j = LBound(s) To UBound(s)
               [COLOR=#FF0000] If s(j) <> "" Then[/COLOR]
                lin = lin + 1
                Sheets("Sheet2").Range("A" & lin & ":C" & lin) = .Range("A" & i & ":C" & i).Value
                Sheets("Sheet2").Range("D" & lin) = s(j)
                Sheets("Sheet2").Range("E" & lin & ":H" & lin) = .Range("E" & i & ":H" & i).Value
                [COLOR=#FF0000]End If[/COLOR]
            Next j
        Next i
        
         Sheets("Sheet2").Range("A1:H1") = .Range("A1:H1").Value
         Sheets("Sheet2").Columns("A:H").AutoFit
    End With
   
End Sub

M.

 

[dougebowl]

That did the trick. Thanks so much for the help!!!!

 

[Marcelo Branco]

That did the trick. Thanks so much for the help!!!!

You are welcome and thanks for the feedback

M.