Divide a string in a single cell into several cells

Question

I have data that I need to split into individual points. My macro charts the data, as a scatter plot, with: Column A as the title of the chart, Column B as the X axis, and Columns C and D as the Y axis. What I need is for when the Product ID has more than 1 number listed to split the numbers out into their own rows and keep the columns B, C, and D the same for each row created form the original. So for row 167, I would want 3 rows (001,002,003) each with packaging, 200, and 100, in B, C, and D respectively. I am not sure where to begin. I tried to build a macro but, I immediately got tripped up when I tried to record a "Find" Formula to run on the data. Any help would be greatly appreciated.

Column A: 001, 002, 003 // Column B:packaging // Column C:200 // Column D:100

Sorry I couldn't post a screenshot of my data, the forum won't let me. If you have any questions please let me know, I will be sure to check in frequently.

Thanks in advance.

Answer 1

Sub DivideData()

'This splits any codes combined into the same line, into their own separate lines with their own separate data

Dim a, b, txt As String, e, s, x As Long, n As Long, i As Long, ii As Long
With Range("a1").CurrentRegion
    a = .Value
    txt = Join$(Application.Transpose(.Columns(1).Value))
    x = Len(txt) - Len(Replace(txt, ",", "")) + .Rows.Count
    ReDim b(1 To x * 2, 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
        For Each e In Split(a(i, 1), ",")
            If e <> "" Then
                For Each s In Split(e, "-")
                    n = n + 1
                    For ii = 1 To UBound(a, 2)
                        b(n, ii) = a(i, ii)
                    Next
                    b(n, 1) = s
                Next
            End If
        Next
    Next
    With .Resize(n)
        .Columns(1).NumberFormat = "@"
        .Value = b
    End With
End With

End Sub

Answer 2

This is a better solution (now that I had more time :) ) - Hope this does the trick!

  Sub SplitUpVals()

  Dim AllVals As Variant
  Dim ArrayIndex As Integer
  Dim RowLooper As Integer


   AllVals = Range("A1").CurrentRegion
   Range("A1").CurrentRegion.Clear

   RowLooper = 1

   For ArrayIndex = 1 To UBound(AllVals, 1)
      ValToSplit = Split(AllVals(ArrayIndex, 1), ",")

        For Each CurrentVal In ValToSplit

           CurrentVal = Trim(CurrentVal)
           Cells(RowLooper, 1).Value = CurrentVal
           Cells(RowLooper, 2).Value = AllVals(ArrayIndex, 2)
           Cells(RowLooper, 3).Value = AllVals(ArrayIndex, 3)
           Cells(RowLooper, 4).Value = AllVals(ArrayIndex, 4)

           RowLooper = RowLooper + 1
         Next

   Next ArrayIndex

  End Sub

Answer 3

I worte this VERY quickly and without much care for efficiency, but this should do the trick:

  Sub SplitUpVals()

  Dim i As Long
  Dim ValsToCopy As Range
  Dim MaxRows As Long
  Dim ValToSplit() As String
  Dim CurrentVal As Variant


     MaxRows = Range("A1").End(xlDown).Row

     For i = 1 To 10000000

        ValToSplit = Split(Cells(i, 1).Value, ",")
        Set ValsToCopy = Range("B" & i & ":D" & i)

        For Each CurrentVal In ValToSplit

           CurrentVal = Trim(CurrentVal)
           Cells(i, 1).Value = CurrentVal
           Range("B" & i & ":D" & i).Value = ValsToCopy.Value

           Cells(i + 1, 1).EntireRow.Insert
           i = i + 1
           MaxRows = MaxRows + 1
        Next

        Cells(i, 1).EntireRow.Delete

     If i > MaxRows Then Exit For

     Next i

  End Sub

As a note, make sure there's no data in cells beneath your data as it might get deleted.

Answer 4

You will need to parse the data in column A. I would do this by splitting the string in to an array, and then iterate over the array items to add/insert additional rows where necessary.

Without seeing your worksheet, I would probably start with something like this, which will split your cell value from column A in to an array, and then you can iterate over the items in the array to manipulate the worksheet as needed.

Sub TestSplit()
Dim myString as String
Dim myArray() as String
Dim cell as Range
Dim i as Long

For each cell in Range("A2",Range("A2").End(xlDown))
    myString = cell.Value 

    myArray = Split(myString, ",")  '<-- converts the comma-delimited string in to an array
    For i = lBound(myArray) to uBound(myArray)
        If i >= 1 Then
            'Add code to manipulate your worksheet, here
        End If
    Next
Next
End Sub