Insert new rows when there is more than 01 item

[dandelion]

Hi,

I'm wondering if there is any formula in Excel for VBA macro that can help to insert new rows when there is more thanan item in a specific column. For example, in the picture attached, in column Supplier, the supplier codes are combined and the outome I want is the second table. It means if there is "/" in the cell in Column Supplier, for example: A0C/DEF has 1"/", then there will be 1 row insert below and Row 1: A0C, Row 2: DEF. the remaining value in other cells will be just copied down.

Thanks in advance

 

[Legacy 143009]

Sub myFunction()
  Dim tArray() As String
  Dim lRow As Integer
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = lRow To 2 Step -1
    tArray = Split(Cells(i, 4).Value, "/")
    If UBound(tArray) > 1 Then
      For ii = 0 to UBound(tArray)-1
        Cells(i, 1).EntireRow.Insert
        Cells(i+ii, 1).Value = Cells(i, 1).Value
        Cells(i+ii, 2).Value = Cells(i, 2).Value
        Cells(i+ii, 3).Value = Cells(i, 3).Value
        Cells(i+ii, 4).Value = tArray(ii)
      Next
    End If
  Next
End Sub

I haven't tested but it should work. I hope

 

[dandelion]

Sub myFunction()
  Dim tArray() As String
  Dim lRow As Integer
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = lRow To 2 Step -1
    tArray = Split(Cells(i, 4).Value, "/")
    If UBound(tArray) > 1 Then
      For ii = 0 to UBound(tArray)-1
        Cells(i, 1).EntireRow.Insert
        Cells(i+ii, 1).Value = Cells(i, 1).Value
        Cells(i+ii, 2).Value = Cells(i, 2).Value
        Cells(i+ii, 3).Value = Cells(i, 3).Value
        Cells(i+ii, 4).Value = tArray(ii)
      Next
    End If
  Next
End Sub

I haven't tested but it should work. I hope

Thanks for spending your time, but I tested, nothing happened...

 

[Legacy 143009]

What are your column names?

 

[Legacy 143009]

Assuming your data from A to D starting from 2nd row. This function works:

Sub myFunction()
  Dim tArray() As String
  Dim lRow As Integer
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = lRow To 2 Step -1
    tArray = Split(Cells(i, 4).Value, "/")
    If UBound(tArray) > O Then
      For ii = 0 To UBound(tArray)
        Cells(i + ii+1, 1).EntireRow.Insert
        Cells(i + ii, 1).Value = Cells(i, 1).Value
        Cells(i + ii, 2).Value = Cells(i, 2).Value
        Cells(i + ii, 3).Value = Cells(i, 3).Value
        Cells(i + ii, 4).Value = tArray(ii)
      Next
      Cells(i + ii, 1).EntireRow.Delete
    End If
  Next
End Sub

 

[dandelion]

Assuming your data from A to D starting from 2nd row. This function works:

Sub myFunction()
  Dim tArray() As String
  Dim lRow As Integer
  lRow = Cells(Rows.Count, 1).End(xlUp).Row

  For i = lRow To 2 Step -1
    tArray = Split(Cells(i, 4).Value, "/")
    If UBound(tArray) > O Then
      For ii = 0 To UBound(tArray)
        Cells(i + ii+1, 1).EntireRow.Insert
        Cells(i + ii, 1).Value = Cells(i, 1).Value
        Cells(i + ii, 2).Value = Cells(i, 2).Value
        Cells(i + ii, 3).Value = Cells(i, 3).Value
        Cells(i + ii, 4).Value = tArray(ii)
      Next
      Cells(i + ii, 1).EntireRow.Delete
    End If
  Next
End Sub

This one works. Thanks a lot

 

[Legacy 143009]

Glad it did help