split cell data into row

[papil]

Hi,

I need help with this query-I want to split the data present in one of the column to multiple rows keeping all other info same.I am using excel 2013.Vlaues in column D will be multiple and separated by spaces.for eg-

Input Columns value-
A B C D E F
1 Hi Yes aaa bbb Bye 99

Ouput-
A B C D E F
1 Hi Yes aaa Bye 99
1 Hi Yes bbb Bye 99

thanks in advance.

 

[papil]

Column E had 2 values -aaa bbb.it got separated into two rows.

 

[papil]

its column E in the question too not column D.

 

[jaslake]

Hi papil

Welcome to the Forum!!!

Please show your data as it actually exists. Are we looking at Column D or Column E?

 

[papil]

i dont see any way to attach my data.
I am looking at column D to be split into two rows and rest of the column information should remain same. I can email the attachment if you can send me your email id.thanks

 

[Rick Rothstein]

See if the code I posted in my mini-blog helps you any....

Redistribute a Delimited Column Of Data into Separate Rows (Keeping Other Data As Is)

 

[jaslake]

Hi papil

If it's Column D try this...

Option Explicit

Sub Split_Col_D()
   Dim LR           As Long
   Dim i            As Long
   Dim Rng          As Range

   Application.ScreenUpdating = False

   LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
       SearchDirection:=xlPrevious).Row

   Set Rng = Range("D2:D" & LR)

   With Rng
      For i = LR To 2 Step -1
         Rng(i).EntireRow.Insert
         Rng(i).Offset(-1, 0).EntireRow.Copy Cells(Rng(i).Row, "A")
         Cells(Rng(i).Row, "D").Value = Split(Cells(Rng(i).Row, "D").Value, " ")(1)
         Cells(Rng(i).Row - 1, "D").Value = Split(Cells(Rng(i).Row - 1, "D").Value, " ")(0)
      Next
   End With

   Application.ScreenUpdating = True
End Sub

 

[papil]

Its working if i have only two words in that column. But my actual file had column from A to CF. And the words in column D can be multiple its not fixed.

So below code gives me script out of range error.

Hi papil

If it's Column D try this...

Option Explicit

Sub Split_Col_D()
   Dim LR           As Long
   Dim i            As Long
   Dim Rng          As Range

   Application.ScreenUpdating = False

   LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
       SearchDirection:=xlPrevious).Row

   Set Rng = Range("D2:D" & LR)

   With Rng
      For i = LR To 2 Step -1
         Rng(i).EntireRow.Insert
         Rng(i).Offset(-1, 0).EntireRow.Copy Cells(Rng(i).Row, "A")
         Cells(Rng(i).Row, "D").Value = Split(Cells(Rng(i).Row, "D").Value, " ")(1)
         Cells(Rng(i).Row - 1, "D").Value = Split(Cells(Rng(i).Row - 1, "D").Value, " ")(0)
      Next
   End With

   Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Its working if i have only two words in that column. But my actual file had column from A to CF. And the words in column D can be multiple its not fixed.

Did you get a chance to try the code I referenced in Message #6 yet?

 

[jaslake]

Hi papil

Based on your Sample Data this appears to work. If Column D is not the operative Column the Code will need to be adjusted. If Column F is not your last Column the Code will need to be adjusted.

Option Explicit

Sub Split_Col_D()
   Dim LR           As Long
   Dim i            As Long
   Dim Rng          As Range
   Dim sp
   Dim j            As Long

   Application.ScreenUpdating = False

   LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
                   SearchDirection:=xlPrevious).Row - 1
   Set Rng = Range("D2:D" & LR)
   With Rng
      For i = LR To 1 Step -1
         sp = Split(Cells(Rng(i).Row, "D").Value, " ")
         If Not UBound(sp) = 0 Then
            Rng(i).Offset(1, 0).Resize(UBound(sp), 1).EntireRow.Insert
            For j = LBound(sp) To UBound(sp)
               Cells(Rng(i).Row + j, "D").Value = sp(j)
            Next j
         End If
      Next i
   End With

   LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
                   SearchDirection:=xlPrevious).Row
   With Range(Cells(2, "A"), Cells(LR, "F"))
      .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
      .Value = .Value
   End With

   Application.ScreenUpdating = True
End Sub