Split string using semicolons as delimiters and paste the value after delimiter in a new row

[siddharthnk]

Hello Mr. Excel, I have 4 columns A, B, C and D. The strings in column A have semi colons ";" in them. What I need is for the this text to be split by the semi-colons and that the value before the first semi colon remains in the same cell. The value after the semi colon is pasted in a blank new row exactly below in column A itself. Meanwhile the values in column B, C & D need to be replicated in the cells below in the new blank row created.
Please let me know if you have any qiestions.

 

[siddharthnk]

Hello Mr. Excel, I have 4 columns A, B, C and D. The strings in column A have semi colons ";" in them. What I need is for the this text to be split by the semi-colons and that the value before the first semi colon remains in the same cell. The value after the semi colon is pasted in a blank new row exactly below in column A itself. Meanwhile the values in column B, C & D need to be replicated in the cells below in the new blank row created.
Please let me know if you have any questions.

I am attaching an image which has before and after scenarios depicted.

 

[Joe4]

Here is one way:

Sub MyStringSplit()

    Dim lr As Long
    Dim r As Long
    Dim i As Long
    Dim str As String
    Dim arr() As String
    
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows in reverse
    For r = lr To 1 Step -1
    
'       Split column A be semi-colon
        str = Cells(r, "A")
        arr = Split(str, ";")
        
'       Check to see if there are multiple values in column A
        If UBound(arr) > 0 Then
'           Loop through values
            For i = UBound(arr) To 1 Step -1
'               Insert new row underneath
                Rows(r + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'               Populate rows
                Cells(r + 1, "A") = arr(i)
                Range(Cells(r, "B"), Cells(r, "D")).Copy Cells(r + 1, "B")
            Next i
'           Update original row
            Cells(r, "A") = arr(0)
        End If
    
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[Marc L]

Hello, a VBA demonstration for starters :​

Sub Demo1()
        Dim R&, S$()
        Application.ScreenUpdating = False
    With [A1].CurrentRegion.Rows
        Do
                R = R + 1
                S = Split(.Cells(R, 1).Text, ";")
            If UBound(S) > 0 Then
               .Cells(R, 1).Value2 = S(0)
                S(0) = "¤"
               .Item(R)(2).Resize(UBound(S)).Insert
               .Item(R).Copy .Item(R)(2).Resize(UBound(S))
               .Cells(R + 1, 1).Resize(UBound(S)).Value2 = Application.Transpose(Filter(S, "¤", False))
                R = R + UBound(S)
            End If
        Loop Until R = .Rows.Count
    End With
        Application.ScreenUpdating = True
End Sub

 

[Marc L]

​

Correction of previous code to avoid a NES : Loop Until IsEmpty(.Cells(R + 1, 1)) …​

 

[siddharthnk]

​

Correction of previous code to avoid a NES : Loop Until IsEmpty(.Cells(R + 1, 1)) …​

Here is one way:

Sub MyStringSplit()

    Dim lr As Long
    Dim r As Long
    Dim i As Long
    Dim str As String
    Dim arr() As String
   
    Application.ScreenUpdating = False
   
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
   
'   Loop through all rows in reverse
    For r = lr To 1 Step -1
   
'       Split column A be semi-colon
        str = Cells(r, "A")
        arr = Split(str, ";")
       
'       Check to see if there are multiple values in column A
        If UBound(arr) > 0 Then
'           Loop through values
            For i = UBound(arr) To 1 Step -1
'               Insert new row underneath
                Rows(r + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'               Populate rows
                Cells(r + 1, "A") = arr(i)
                Range(Cells(r, "B"), Cells(r, "D")).Copy Cells(r + 1, "B")
            Next i
'           Update original row
            Cells(r, "A") = arr(0)
        End If
   
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

Thank you. Trying out the code. Will let you know how it goes. What i have immediately noticed is that, when I replace the column header names A, B, C & D with the actual names inside quotes, there is a debug error in row " lr = Cells(Rows.Count, "A").End(xlUp).Row", do you know why this is happening?

 

[Joe4]

If you copy my code "as-is" (and do not try to type it), and if you really have data in column A, B, C, and D, in the structure you have shown, my code should work.

I don't see how that line of code should return an error, unless you have merged or protected cells or some other weird thing going on.
It is quite simply return the last row in column A with data in it.

 

[siddharthnk]

If you copy my code "as-is" (and do not try to type it), and if you really have data in column A, B, C, and D, in the structure you have shown, my code should work.

I don't see how that line of code should return an error, unless you have merged or protected cells or some other weird thing going on.
It is quite simply return the last row in column A with data in it.

Correct. If my column headers are named A, B, C & D then the code works seamlessly. However, we do have spreadsheets where the names are "Technology Name", "Task Name", "Defenitions" and "Active" as column names.

 

[Joe4]

Don't be confused by the "A" in this line of code:

    lr = Cells(Rows.Count, "A").End(xlUp).Row

The "A" is not referring to a column title (it has nothing to do with that). It is referring to the column letter.
In "Cells", you can also refer to the column by the number instead of the letter, like this:

    lr = Cells(Rows.Count, 1).End(xlUp).Row

Either one should work.

If you are getting errors on that line of code, please answer the following questions:
1. Do you have any merged or protected cells on your workbook?
2. Is your data in a data table?

Also, please update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)