0

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?

Community
  • 1
  • 1
Avionicom
  • 191
  • 2
  • 5
  • 19

1 Answers1

2

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
user3598756
  • 28,893
  • 4
  • 18
  • 28
  • Hello and thank you for your answer. Your solutions seems to produce my same results. There is no shift down of the values. – Avionicom Jan 21 '17 at 16:06
  • 1
    I thought that _"but it do not move down the column B values"_ meant it wasn't looping down all column B data. Now I get that you wanted column B values shifted down one row. See edited answer – user3598756 Jan 21 '17 at 16:10
  • Thank you, now it's ok but all the values are on a single sheet. Is it possible to put PRE and POST values into two separate sheets? – Avionicom Jan 21 '17 at 16:13
  • they are already put in separate sheets: `With Worksheets.Add(after:=Sheets(Sheets.Count))` statement adds a new sheet to put separated cells into – user3598756 Jan 21 '17 at 16:18
  • Are you sure? The second sheet is void and all the values are on the first sheet. – Avionicom Jan 21 '17 at 16:21
  • As per your code it's assumed that when the macro starts the "PRE" sheet is the _Active_ one. – user3598756 Jan 21 '17 at 16:25
  • Yes, with the PRE sheet active, when I run your function I obtain the active sheet with the PRE and POST values plus an empty second sheet. – Avionicom Jan 21 '17 at 16:29
  • Let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/133710/discussion-between-avionicom-and-user3598756). – Avionicom Jan 21 '17 at 16:36
  • @Avionicom, did you get through it? – user3598756 Jan 21 '17 at 16:54
  • Yes, now it's ok. If I have a third column C and I want to keep the cell values in the same row of the values in Column A... how to do? – Avionicom Jan 21 '17 at 17:21
  • 1
    see edited answer. but please be informed that new issues require a new post where your showing some coding efforts would earn you more chance to get an answer – user3598756 Jan 21 '17 at 17:34