Delimited Data by rows and copy respective data

[uday]

Hi,

I have written one vba code where Data 3 will be delimited by "," and inserting rows depends on delimited values count.
Now, the this code does not copying respecting data which is present in Data 1 and Data 2 rows.

I have paste the expected output in Expected result tab. Please help.

Regards,
Uday

 

[vletm]

uday
This sample will copy those datas too ...

 

[p45cal]

Try:

Sub SplitString()
Dim Genres As Variant
Dim i As Integer
Dim r As Range
Dim FirstCellRef As String
Dim sn As String
 
Set r = Sheets("Detail Sheet").Range("G2", Sheets("Detail Sheet").Range("G2").End(xlDown)).Find(WHAT:=",", LOOKAT:=xlPart)
If Not r Is Nothing Then
  Do
    Genres = Split(r.Value, ",")
    r.EntireRow.Copy
    r.Offset(1, 0).Resize(UBound(Genres)).EntireRow.Insert
    For i = 0 To UBound(Genres)
      r.Offset(i, 0).Value = Genres(i)
    Next i
    Set r = Sheets("Detail Sheet").Range("G2", Sheets("Detail Sheet").Range("G2").End(xlDown)).FindNext(r)
  Loop While Not r Is Nothing    'And r.Address <> FirstCellRef
End If
End Sub

 

[Marc L]

Hi, according to the attachment a VBA demonstration for starters :​

Sub Demo1()
        Dim W, V, L&, X, C%, R&
    With Sheet1
            W = .UsedRange.Value2
            ReDim V(.Rows.Count - 2, 1 To UBound(W, 2))
        For L = 2 To UBound(W)
        For Each X In Split(W(L, 3), ",")
            W(L, 3) = X
            For C = 1 To UBound(W, 2):  V(R, C) = W(L, C):  Next
            R = R + 1
        Next X, L
            If R Then .[A2].Resize(R, C - 1).Value2 = V
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[uday]

Thanks for helping