VBA Split comma separated values in new rows and return the original description

[Todor T]

Hi all, here is what I am trying to do:



I have comma separated values (Variants) mapped with unique description. I am trying to split the values in new rows, but keeping the original description.
This code from DanteAmor works great for the split, but I can not modify it to return the descriptions.

Sub test_Comma()
  Dim n As Long
  Dim Cell As Range
  Dim itm As Variant
  n = Sheets(2).Range("B" & Rows.Count).End(3).Row
  For Each Cell In Sheets(1).Range("A1", Sheets(1).Range("A" & Rows.Count).End(3))
    For Each itm In Split(Cell, ",")    'Split cells 'iterate through the array
      n = n + 1
      Sheets(2).Range("B" & n).Value = Trim(itm)
    Next itm
  Next Cell
End Sub

Thanks in advance for you can help.

 

[Snakehips]

@Todor T Welcome
With your input sheet as Tab1 and your Output sheet as Tab 2 test the following.

Sub test_Comma()
  Dim n As Long
  Dim Cell As Range
  Dim itm As Variant
  n = Sheets(2).Range("B" & Rows.Count).End(3).Row
  For Each Cell In Sheets(1).Range("B1", Sheets(1).Range("B" & Rows.Count).End(3))
    For Each itm In Split(Cell, ",")    'Split cells 'iterate through the array
      n = n + 1
      Sheets(2).Range("A" & n).Value = Cell.Offset(0, -1).Value
      Sheets(2).Range("B" & n).Value = Trim(itm)
    Next itm
  Next Cell
End Sub

If you are not confident that those sheets will always remain in that tab order then it may be better to make reference to the sheets by name rather than tab index.
Hope that helps.

 

[Todor T]

@Todor T Welcome
With your input sheet as Tab1 and your Output sheet as Tab 2 test the following.

Sub test_Comma()
  Dim n As Long
  Dim Cell As Range
  Dim itm As Variant
  n = Sheets(2).Range("B" & Rows.Count).End(3).Row
  For Each Cell In Sheets(1).Range("B1", Sheets(1).Range("B" & Rows.Count).End(3))
    For Each itm In Split(Cell, ",")    'Split cells 'iterate through the array
      n = n + 1
      Sheets(2).Range("A" & n).Value = Cell.Offset(0, -1).Value
      Sheets(2).Range("B" & n).Value = Trim(itm)
    Next itm
  Next Cell
End Sub

If you are not confident that those sheets will always remain in that tab order then it may be better to make reference to the sheets by name rather than tab index.
Hope that helps.

Thank you Snakehips!
It works perfect. I'll follow your advice for the references.
Best Regards Todor

 

[alansidman]

This can also be accomplished using Power Query aka Get and Transform Data and found on the Data Tab of the Ribbon.
1. Data-->Get and Transform-->From Range/Table
2. In the PQ Editor, Split Column-->By Delimiter-->Comma-->Advanced Options-->Rows--OK
3. On the PQ Editor Ribbon, Close and Load

No VBA or coding required.

 

[Todor T]

This can also be accomplished using Power Query aka Get and Transform Data and found on the Data Tab of the Ribbon.
1. Data-->Get and Transform-->From Range/Table
2. In the PQ Editor, Split Column-->By Delimiter-->Comma-->Advanced Options-->Rows--OK
3. On the PQ Editor Ribbon, Close and Load

No VBA or coding required.

Thank you for your reply and the Power Query alternative Alan!
The code is a part of a bigger macro and has to be VBA.

Best Regards Todor