CODEWITHSUNDEEP
excelexcel-formulaexcel-2010vba
Rick
Rick

Reputation: 2308

Excel: Row value to columns

I have the following table:

Name        Group
John        2A
John        1B
Barry       2A
Ron         1B
Ron         2A
Ron         2C

I wanted to know if there was any utility in Excel where I can separate the group column into a new column of for each instance.

Expected Result

Name        Group1      Group2      Group3
John        2A          1B
Barry       2A
Ron         1B          2A          2C

In this example I know that the max Groups are 3. So I made Group1, Group2, and Group3 columns.

Upvotes: 0

Views: 1453

Answers (2)

pnuts
pnuts

Reputation: 59475

Assuming 2C is in B7 and working on a copy, put:

=IF(COLUMN()<COUNTIF($A:$A,$A2)+2,IF($A2=$A3,INDIRECT("$B"&ROW()+COLUMN()-2),""),"")

in C2 and copy across (to ColumnZ or further if you wish but to ColumnD would be sufficient for your example) and down to suit.

In an available column put:

=OR(A1=A3,A1=A2)

and copy down to suit.

Fix the formulae (Select/Copy/Paste Special Values), filter on the 'available' column to select TRUE, delete selected rows and delete the 'available' column. Add column labels to suit.

Upvotes: 1

tigeravatar
tigeravatar

Reputation: 26650

Here is a VBA solution that will put the converted table on a new sheet:

Sub tgr()

    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim NameCell As Range
    Dim rngFound As Range
    Dim arrData() As Variant
    Dim strFirst As String
    Dim DataIndex As Long
    Dim cIndex As Long

    Set wsData = ActiveSheet
    Set wsDest = Sheets.Add(After:=Sheets(Sheets.Count))
    wsData.Range("A1", wsData.Cells(Rows.Count, "A").End(xlUp)).AdvancedFilter xlFilterCopy, , wsDest.Range("A1"), True
    wsData.Range("B1", wsData.Cells(Rows.Count, "B").End(xlUp)).AdvancedFilter xlFilterCopy, , wsDest.Range("B1"), True
    wsDest.Range("B2", wsDest.Cells(Rows.Count, "B").End(xlUp)).Copy
    wsDest.Range("B1").PasteSpecial xlPasteValues, Transpose:=True
    With wsDest.Range("A1", wsDest.Cells(1, Columns.Count).End(xlToLeft))
        .Font.Bold = True
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        With .Offset(, 1).Resize(, .Columns.Count - 1)
            .Value = Application.Transpose(Evaluate("Index(""Group""&Row(1:" & .Columns.Count & "),)"))
        End With
    End With
    ReDim arrData(1 To wsDest.Cells(Rows.Count, "A").End(xlUp).Row - 1, 1 To wsDest.Cells(1, Columns.Count).End(xlToLeft).Column - 1)
    For Each NameCell In wsDest.Range("A2", wsDest.Cells(Rows.Count, "A").End(xlUp)).Cells
        DataIndex = DataIndex + 1
        Set rngFound = wsData.Columns("A").Find(NameCell.Text, , xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            cIndex = 0
            strFirst = rngFound.Address
            Do
                cIndex = cIndex + 1
                arrData(DataIndex, cIndex) = wsData.Cells(rngFound.Row, "B").Text
                Set rngFound = wsData.Columns("A").Find(NameCell.Text, rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
        End If
    Next NameCell

    If DataIndex > 0 Then wsDest.Range("B2").Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData

    Set wsData = Nothing
    Set wsDest = Nothing
    Set NameCell = Nothing
    Set rngFound = Nothing
    Erase arrData

End Sub

How to use a macro:

  1. Make a copy of the workbook the macro will be run on
    • Always run new code on a workbook copy, just in case the code doesn't run smoothly
    • This is especially true of any code that deletes anything
  2. In the copied workbook, press ALT+F11 to open the Visual Basic Editor
  3. Insert | Module Copy the provided code and paste into the module
  4. Close the Visual Basic Editor
  5. In Excel, press ALT+F8 to bring up the list of available macros to run
  6. Double-click the desired macro (I named this one tgr)

Upvotes: 0

Related Questions