desagree in excel

Question

Hello, 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: http://stackoverflow.com/questions/473553/excel-macro-comma-separated-cells-to-rows-preserve-aggregate-column

Thanks!

Answer 1

I don't know much VBA, so you'll have to figure that out for yourself. However, I would use Text to Columns to convert the CSV section to individual columns, then a Paste Special with the Transpose option to turn the a b c columns into rows.

Answer 2

Here are some notes.

Sub SplitRows()
strFile = Workbooks(1).FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rss = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM [Sheet4$]"

rs.Open strSQL, cn

For i = 0 To rs.Fields.Count - 1
    If Not IsNumeric(rs.Fields(i)) Then
        rss.Fields.Append rs.Fields(i).Name, adVarWChar, 255
    Else
        rss.Fields.Append rs.Fields(i).Name, adInteger
    End If
Next

rss.Open

Do While Not rs.EOF
    cat = Split(rs.Fields(3), " ")
    a = Split(cat(1), ",")
    For i = 0 To UBound(a)

        rss.AddNew

        For j = 0 To rs.Fields.Count - 1
            If j = 3 Then
                rss(j) = cat(0) & " " & a(i)
            Else
                rss(j) = rs(j)
            End If
        Next

        rss.Update

    Next
    rs.MoveNext
Loop

rss.MoveFirst
Worksheets("Sheet5").Cells(2, 1).CopyFromRecordset rss

End Sub

Answer 3

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