Question

I need your help in this case:

I have:

1    11    111    Cat1 a,b,c  2    22    222    Cat2 d  3    33    333    Cat3 e,f  4    44    444    Cat4 g,h,i 

and i want:

1    11    111    Cat1 a  1    11    111    Cat1 b  1    11    111    Cat1 c  2    22    222    Cat2 d  3    33    333    Cat3 e  3    33    333    Cat3 f  4    44    444    Cat4 g  4    44    444    Cat4 h  4    44    444    Cat4 i 

you can help me to make this macro? I have written 5 columns but i need the macro for 20 columns but the best will be that i can choose the number of columns in the macro.

Its near that this case but with more columns: Excel Macro – Comma Separated Cells to Rows Preserve/Aggregate Column

Thanks!

Answer 1

This code should be what you are looking for, the method ExpandData(String, String, String) takes the start column for the set of data (in this case ‘A’) for the first parameter, the end column for the set of data to copy as the second parameter (in this case ‘D’) and finally the column with the set of data that is comma seperated (‘E’ here).

You should probably expand it so that it also takes a starting row or just make it an addin formula thing where it takes a range and a column.

Hope this helps.

Sub ExpandDat()     ExpandData 'A', 'D', 'E' End Sub  Sub ExpandData(start_range As String, end_range As String, comma_column As String)     Const FirstRow = 1     Dim LastRow As Long     LastRow = Range(start_range & CStr(Rows.Count)).End(xlUp).Row      ' Get the values from the worksheet '     Dim SourceRange As Range     Set SourceRange = Range(start_range & CStr(FirstRow) & ':' & end_range & CStr(LastRow))      ' Get the comma seperated values as a different set of values '     Dim CommaRange As Range     Set CommaRange = Range(comma_column & CStr(FirstRow) & ':' & comma_column & CStr(LastRow))      ' Get the values from the actual values '     Dim Vals() As Variant     Vals = SourceRange.Value      ' We need to know the upper and lower bounds of the second dimension in the Vals Array '     Dim lower As Integer     Dim upper As Integer     lower = LBound(Vals, 2)     upper = UBound(Vals, 2)      ' Get the comma seperated values '     Dim Commas() As Variant     Commas = CommaRange.Value      ' Loop through the rows in the array and split each comma-delimited list of items and put each on its own row '     Dim ArrIdx As Long     Dim RowCount As Long     For ArrIdx = LBound(Commas, 1) To UBound(Commas, 1)          Dim CurrList As String         CurrList = Replace(Commas(ArrIdx, 1), ' ', '')          ' Split the Comma set into an array '         Dim ListItems() As String         ListItems = Split(CurrList, ',')          ' For each value in the Comma Seperated values write the output '         Dim ListIdx As Integer         For ListIdx = LBound(ListItems) To UBound(ListItems)             ' Loop through the values in our source range and output them '             For Idx = lower To upper                 Range(start_range & CStr(FirstRow + RowCount)).Offset(0, Idx - 1).Value = Vals(ArrIdx, Idx)             Next Idx              Range(comma_column & CStr(FirstRow + RowCount)).Value = ListItems(ListIdx)             RowCount = RowCount + 1          Next ListIdx      Next ArrIdx  End Sub