Convert multi-line Excel group to individual lines

Question

I have an Excel document with groups and username names in such a format:

Group1          user1
                user2
                user3
Group2          user2
                user4
Group3          user5

etc.etc. Each of the Groups is a single row, with all the users as a multiline entry inside a cell.

I need it to be in a single line format, so I can export it as a CSV and do something useful with it.

I don't care HOW it gets transformed (excel hotkey, python script, whatever) but it needs to look like:

Group1         user1
Group1         user2
Group1         user3
Group2         user2
Group2         user4
Group3         user5

score 0 · Accepted Answer · answered Apr 07 '11 at 15:34

Not sure I should be answering my own question, but a coworker was able to supply the answer.

Using VBS I was able to create a module that did specifically what I needed. The code is below, where the iColumn variable is the column with the multiline data.

Credit for the code goes to http://excel.tips.net/T003263_Splitting_Information_into_Rows.html

Sub CellSplitter1()
    Dim Temp As Variant
    Dim CText As String
    Dim J As Integer
    Dim K As Integer
    Dim L As Integer
    Dim iColumn As Integer
    Dim lNumCols As Long
    Dim lNumRows As Long

    iColumn = 2

    Set wksSource = ActiveSheet
    Set wksNew = Worksheets.Add

    iTargetRow = 0
    With wksSource
        lNumCols = .Range("IV1").End(xlToLeft).Column
        lNumRows = .Range("A65536").End(xlUp).Row
        For J = 1 To lNumRows
            CText = .Cells(J, iColumn).Value
            Temp = Split(CText, Chr(10))
            For K = 0 To UBound(Temp)
                iTargetRow = iTargetRow + 1
                For L = 1 To lNumCols
                    If L <> iColumn Then
                        wksNew.Cells(iTargetRow, L) _
                          = .Cells(J, L)
                    Else
                        wksNew.Cells(iTargetRow, L) _
                          = Temp(K)
                    End If
                Next L
            Next K
        Next J
    End With
End Sub

score 0 · Answer 2 · answered Apr 08 '11 at 13:00

Unless I've misunderstood the task, the code to get the job done can be a lot simpler. This should work:

Sub ungrouper()

    'Assumes that users column does not contain blank cells.

    Dim users() As Variant
    Dim groups() As Variant
    Dim rngUsers As Range
    Dim rngGroups As Range

    Dim j As Integer
    Dim k As Integer

    'Change Column to match layout of your workbook.
    Set rngUsers = Range("B1", Range("B1").End(xlDown))
    users = rngUsers

    j = 1
    k = 1

    'Change column offset to match the layout of your workbook.
    Set rngGroups = rngUsers.Offset(0, -1)
    groups = rngGroups

    Do While j <= UBound(users)
        If groups(j, 1) = Empty Then
            groups(j, 1) = groups(j - 1, 1)
        End If
        j = j + 1
    Loop

    rngGroups.Value = groups

End Sub

Convert multi-line Excel group to individual lines

2 Answers2