CODEWITHSUNDEEP
vbaexcel
Avionicom
Avionicom

Reputation: 191

Split text in cells at commas

Let's assume a simple Excel spreadsheet with two columns A and B, where in the B column there are comma separated values. I need a VBA function to split these values each one in new rows starting from the row just below the cell that contains them. Here an example:

PRE

Column A     Column B
AAAAA        this,is,a,test
BBBBB        other,values
CCCCC        1,2,3,4

POST

Column A     Column B
AAAAA        
             this
             is
             a
             test
BBBBB        
             other
             values
CCCCC        
             1
             2
             3
             4

I found this question that helped me: Split text in cells at line breaks and modified its solution in this way:

Sub SplitIt()
ActiveSheet.Copy after:=Sheets(Sheets.count)
Dim tmpArr As Variant
Dim Cell As Range
For Each Cell In Range("B1", Range("B2").End(xlDown))

    If InStr(1, Cell, ",") <> 0 Then
        tmpArr = Split(Cell, ",")

        Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _
            EntireRow.Insert xlShiftDown

        Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)
    End If
Next
Application.CutCopyMode = False
End Sub

but it do not move down the column B values. Is there a way to do it?

Upvotes: 0

Views: 648

Answers (1)

user3598756
user3598756

Reputation: 29421

edited after OP's clarification the issue was the shifting of the values in column B

edited 2 to handle the fact that in Excel 2016 it seems the newly added sheet doesn't become the Active one

edited 3 to account for values in column C

Sub SplitIt()
    Dim tmpArr As Variant, vals As Variant
    Dim iRow As Long

    vals = Range("C1", Cells(Rows.Count, "A").End(xlUp)).value
    With Worksheets.Add(after:=Sheets(Sheets.Count))
        For iRow = LBound(vals) To UBound(vals)
            tmpArr = VBA.Split(vals(iRow, 2), ",")
            With .Cells(Rows.Count, "B").End(xlUp).Offset(1)
                .Offset(, -1).value = vals(iRow, 1)
                .Offset(1).Resize(UBound(tmpArr) + 1).value = Application.Transpose(tmpArr)
                .Offset(, 1).value = vals(iRow, 3)
            End With
        Next
    End With
End Sub

Upvotes: 2

Related Questions