title: Excel/VBA Breakdown field
body: <p>Bit of a complicated task I have to do but I will try and explain. I have an excel file with 23000 lines of data which I am importing into a website. Each one has a field like so:</p>
  
  <pre><code>Category | other data | other data 2 
  
  Foods/Dog/Treats Pre-Pack | 1223 | image.jpg
  </code></pre>
  
  <p>I need it to grab each line and add a new line below it for each "/" so turning the above into:</p>
  
  <pre><code>Category | other data | other data 2 
  
  [blank in original line] | 1223 | image.jpg
  
  Foods | [blank field] | [blank field]
  
  Foods/Dog | [blank field] | [blank field]
  
  Foods/Dog/Treats Pre-Pack | [blank field] | [blank field]
  </code></pre>
  
  <p>So the script needs to add a new line for each category but keeping the original category in front of it. So turning <code>category/category2/category 3</code> into 4 lines of: <code>[blank] - category - category/category2 - category/category2/category 3</code></p>
  
  <p>Does anyone know a way or script to do this?</p>
  
  <p>Thanks, Simon</p>
  
  <p>Note: The worksheet is called "test" and the category column starts at E2 and goes to E23521</p>
  
  <p>I have the following script:</p>
  
  <pre><code>Sub test()
      Dim a, i As Long, ii As Long, e, n As Long
      Dim b(), txt As String, x As Long
      With Range("a1").CurrentRegion
          a = .Value
          txt = Join$(Application.Transpose(.Columns(5).Value))
          With CreateObject("VBScript.RegExp")
              .Global = True
              .Pattern = "/"
              x = .Execute(txt).Count * 2
          End With
          ReDim b(1 To UBound(a, 1) + x, 1 To UBound(a, 2))
          For i = 1 To UBound(a, 1)
              If a(i, 5) &lt;&gt; "" Then
                  For Each e In Split(a(i, 5), "/")
                      n = n + 1
                      For ii = 1 To UBound(a, 2)
                          b(n, ii) = a(i, ii)
                      Next
                      b(n, 5) = Trim$(e)
                  Next
              End If
          Next
          .Resize(n).Value = b
      End With
  End Sub
  </code></pre>
  
  <p>This seems to create a new row as I need it to but does not keep the slash structuring moving up with each one. And also dosnt add a blank line on all the new ones and make the original category value blank.</p>
  
  <p>SOLVED:</p>
  
  <pre><code>Sub splitEmUp()
      Dim splitter() As String 'this is storage space for the split function
      Dim i As Integer ' main-loop for counter "which cell we are on"
      Dim j As Integer ' splitter for-loop counter "which section of the split are we on"
      Range("E2").Activate 'starting in cell e2 because row 1 is headers and category is located in the B column
  
     For i = 0 To 24000 'from beginning to end i=0 means e2, i=1 means e3
          ActiveCell.Offset(i, 0).Value = Replace(ActiveCell.Offset(i, 0).Value, " / ", "!@#")
          splitter = Split(ActiveCell.Offset(i, 0), "/") 'split the cell based on / and store it in splitter
          If (UBound(splitter)) &gt; 0 Then 'if a split occurred
              ActiveCell.Offset(i, 0).Value = "" 'set the activecell to blank
              Debug.Print i
              ActiveCell.Offset(i + 1, 0).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'insert a new row and shift everything down
  
              ActiveCell.Offset(i + 1, 0).Value = splitter(0) 'initialize the "Down" cells
              ActiveCell.Offset(i + 1, 0).Value = Replace(ActiveCell.Offset(i + 1, 0).Value, "!@#", " / ")
              For j = 1 To UBound(splitter)
                  ActiveCell.Offset(i + j + 1).EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove 'create another row if it needs to
                  ActiveCell.Offset(i + (j + 1), 0).Value = ActiveCell.Offset(i + j).Value &amp; "/" &amp; splitter(j) 'fill out the new row
                  ActiveCell.Offset(i + (j + 1), 0).Value = Replace(ActiveCell.Offset(i + (j + 1), 0).Value, "!@#", " / ")
              Next
              i = i + UBound(splitter) + 1 'need to step I past the new cells
              ReDim splitter(0)
              Erase splitter 'erase and eliminate splitter to avoid carry over.
  
          End If
      Next
  
  End Sub
  </code></pre>