Split concatenated cells over multiple rows

[ewarthur]

Hello,

I have the following code which I want to amend to skip rows where there is no data. This macros looks at column J where there can be concatenated values, deiminated by a comma. The code then splits the concatenated values over new lines immediately below, copying the other columns with it. Finally, before moving on to the next row, Excel deletes the original row.

Sometimes column J is null and contains no values at all. In this instance, this is throwing an error and causing corruption in the results. I then see a particular record has values that don't belong to it once the macro has been run.

I'd like to amend the code below to check each time, if column J has data in it. If not, then go to the next row, without deleting this current row. It then goes to the next row with data and splits the concatenated data over as many rows as there are items to split ie ("car, bus, train" creates 3 new lines) and deletes the original line,

Thanks in advance if you can help.

Sub ProcessCRM()

Dim lastrow As Integer
Dim i As Integer
Dim descriptions() As String

With Worksheets("Clients")
    lastrow = .Range("J2").End(xlDown).Row
    For i = lastrow To 2 Step -1
        If InStr(1, .Range("J" & i).Value, ",") <> 0 Then
            descriptions = Split(.Range("J" & i).Value, ",")
        End If
        For Each Item In descriptions
            .Range("J" & i).Value = Item
            .Rows(i).Copy
            .Rows(i).Insert
        Next Item
        .Rows(i).EntireRow.Delete

    Next i
End With


With Worksheets("Clients")
    lastrow = .Range("J2").End(xlDown).Row
    
    For i = 2 To lastrow
        .Cells(i, "J").Value = Trim(.Cells(i, "J").Value)
    Next i
End With


End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

What about some sample data and expected results so that we can see exactly what you have and what you want to achieve, and also have some sample data to test with?

MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

 

[Alex Blakenburg]

Try this:
Changes
1) xlDown won't work if you are expecting blanks in column J, changed to xlUp version
2) Your active code is outside the IF End If, moved inside the IF End If
3) Item was not defined, added Dim

Sub ProcessCRMMod()

    Dim lastrow As Integer
    Dim i As Integer
    Dim descriptions() As String
    Dim item As Variant
  
    With Worksheets("Clients")
        'XXX Change from xlDown to xlUp
        lastrow = .Range("J" & Rows.Count).End(xlUp).Row
        For i = lastrow To 2 Step -1
            If InStr(1, .Range("J" & i).Value, ",") <> 0 Then
                descriptions = Split(.Range("J" & i).Value, ",")
              
                'XXX Moved active code inside If statement
                For Each item In descriptions
                    .Range("J" & i).Value = item
                    .Rows(i).Copy
                    .Rows(i).Insert
                Next item
                .Rows(i).EntireRow.Delete
            End If

        Next i
    End With
  
    With Worksheets("Clients")
        lastrow = .Range("J2").End(xlDown).Row
      
        For i = 2 To lastrow
            .Cells(i, "J").Value = Trim(.Cells(i, "J").Value)
        Next i
    End With

End Sub

My Dummy data in case it helps anyone else.

20211005 VBA Split and populate rows.xlsm
	A	B	C	D	E	F	G	H	I	J
1	Col1	Col2	Col3	Col4	Col5	Col6	Col7	Col8	Col9	Col10
2	2	2	2	2	2	2	2	2	2	car, bus, train
3	3	3	3	3	3	3	3	3	3
4	4	4	4	4	4	4	4	4	4	apple,orange,pear
5	5	5	5	5	5	5	5	5	5	Item 1, another item, one more item
Clients

 

[ewarthur]

Try this:
Changes
1) xlDown won't work if you are expecting blanks in column J, changed to xlUp version
2) Your active code is outside the IF End If, moved inside the IF End If
3) Item was not defined, added Dim

Sub ProcessCRMMod()

    Dim lastrow As Integer
    Dim i As Integer
    Dim descriptions() As String
    Dim item As Variant
 
    With Worksheets("Clients")
        'XXX Change from xlDown to xlUp
        lastrow = .Range("J" & Rows.Count).End(xlUp).Row
        For i = lastrow To 2 Step -1
            If InStr(1, .Range("J" & i).Value, ",") <> 0 Then
                descriptions = Split(.Range("J" & i).Value, ",")
             
                'XXX Moved active code inside If statement
                For Each item In descriptions
                    .Range("J" & i).Value = item
                    .Rows(i).Copy
                    .Rows(i).Insert
                Next item
                .Rows(i).EntireRow.Delete
            End If

        Next i
    End With
 
    With Worksheets("Clients")
        lastrow = .Range("J2").End(xlDown).Row
     
        For i = 2 To lastrow
            .Cells(i, "J").Value = Trim(.Cells(i, "J").Value)
        Next i
    End With

End Sub

My Dummy data in case it helps anyone else.

20211005 VBA Split and populate rows.xlsm
	A	B	C	D	E	F	G	H	I	J
1	Col1	Col2	Col3	Col4	Col5	Col6	Col7	Col8	Col9	Col10
2	2	2	2	2	2	2	2	2	2	car, bus, train
3	3	3	3	3	3	3	3	3	3
4	4	4	4	4	4	4	4	4	4	apple,orange,pear
5	5	5	5	5	5	5	5	5	5	Item 1, another item, one more item
Clients

Alex,

Thank you so much for giving me working code but also explaining why my version didn't give the results I hoped for.

Best Regards,

Eric