Separate Comma values in the cell and replacing in a new row by copying the original content

[mayaa_mmm]

I want to split the content in a column (Vendor 1, Vendor 2, Vendor 3) into different rows.

[TABLE="width: 1291"]
<colgroup><col><col><col><col><col><col><col span="2"></colgroup><tbody>[TR]
[TD]Name[/TD]
[TD]Type[/TD]
[TD]Name[/TD]
[TD]Vendor 1[/TD]
[TD]Vendor 2[/TD]
[TD]Vendor 3[/TD]
[TD]Manager[/TD]
[TD]Available[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]1[/TD]
[TD]Kashmir[/TD]
[TD]Padma whole sale[/TD]
[TD]Fruit Junction; Juice corner[/TD]
[TD]Hypercity; Star bazzar[/TD]
[TD]Anthony[/TD]
[TD]multiple[/TD]
[/TR]
[TR]
[TD]Orange[/TD]
[TD]2[/TD]
[TD]Australia[/TD]
[TD]Padma whole sale;Fruit Junction[/TD]
[TD]Juice corner[/TD]
[TD][/TD]
[TD]Gopi[/TD]
[TD]Single[/TD]
[/TR]
[TR]
[TD]Grapes[/TD]
[TD]3[/TD]
[TD]Australia[/TD]
[TD][/TD]
[TD]Padma whole sale;Fruit Junction[/TD]
[TD]Hypercity; Star bazzar[/TD]
[TD]Preethi[/TD]
[TD]Multiple[/TD]
[/TR]
</tbody>[/TABLE]

Final outcome should be like below for every items.

[TABLE="width: 994"]
<colgroup><col><col><col><col><col><col><col span="2"></colgroup><tbody>[TR]
[TD]Name[/TD]
[TD]Type[/TD]
[TD]Name[/TD]
[TD]Vendor 1[/TD]
[TD]Vendor 2[/TD]
[TD]Vendor 3[/TD]
[TD]Manager[/TD]
[TD]Available[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]1[/TD]
[TD]Kashmir[/TD]
[TD]Padma whole sale[/TD]
[TD][/TD]
[TD][/TD]
[TD]Anthony[/TD]
[TD]multiple[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]1[/TD]
[TD]Kashmir[/TD]
[TD][/TD]
[TD]Fruit Junction[/TD]
[TD][/TD]
[TD]Anthony[/TD]
[TD]multiple[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]1[/TD]
[TD]Kashmir[/TD]
[TD][/TD]
[TD] Juice corner[/TD]
[TD][/TD]
[TD]Anthony[/TD]
[TD]multiple[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]1[/TD]
[TD]Kashmir[/TD]
[TD][/TD]
[TD][/TD]
[TD]Hypercity[/TD]
[TD]Anthony[/TD]
[TD]multiple[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]1[/TD]
[TD]Kashmir[/TD]
[TD][/TD]
[TD][/TD]
[TD]Star bazzar[/TD]
[TD]Anthony[/TD]
[TD]multiple[/TD]
[/TR]
</tbody>[/TABLE]


It will be helpful for us. It will save the tons of Time

 

[bertie]

Using the sample data provided I have assumed:
Data is on Sheet1
Data starts in cell A1.
The code loops through column A until it reaches an empty cell.

Place the code in a standard module, i.e., Insert=>Module
The code loops through the data and generates new output in the columns to the right of the existing data.
Use the sample data provided to test the code.

Option Explicit


Sub ParseData()
   Dim rngRow As Range        'column A entries to loop through
   Dim rowSource As Long      'source row
   Dim rowTarget As Long      'output row
   Dim colTarget As Long      'output column
   Dim arrVendor As Variant
   Dim col As Long            'column loop index
   Dim i As Long              'array loop index
   
   'initialize variables
   Set rngRow = Sheets("Sheet1").Range("A2")
   rowTarget = 1
   
   'loop through rows
   Do Until rngRow = ""
      rowSource = rngRow.Row
      
      'loop through columns
      For col = 4 To 6
         
         'does this cell contain a value?
         If Sheets("Sheet1").Cells(rowSource, col).Value <> "" Then
            
            'populate the vendor array, separate by semi colon
            arrVendor = Split(Sheets("Sheet1").Cells(rowSource, col).Value, ";")
            
            'loop through the array
            For i = LBound(arrVendor) To UBound(arrVendor)
               rowTarget = rowTarget + 1
               
               'output
               With Sheets("Sheet1")
                  .Range("J" & rowTarget).Value = .Range("A" & rowSource).Value  'name
                  .Range("K" & rowTarget).Value = .Range("B" & rowSource).Value  'type
                  .Range("L" & rowTarget).Value = .Range("C" & rowSource).Value  'area
                  .Cells(rowTarget, col + 9).Value = Trim(arrVendor(i))          'vendor
                  .Range("P" & rowTarget).Value = .Range("G" & rowSource).Value  'manager
                  .Range("Q" & rowTarget).Value = .Range("C" & rowSource).Value  'available
               End With
            Next i
         End If
         
      Next col


      'get next row
      Set rngRow = rngRow.Offset(1, 0)
   Loop


   'tidy up
   Set rngRow = Nothing
End Sub