Consolidating Columns in Excel

Question

I have two columns in excel like the following

a,apple
a,bannana
a,orange
a,plum
b,apple
b,berry
b,orange
b,grapefruit
c,melon
c,berry
c,kiwi

I need to consolidate them like this on a different sheet

a,apple,bannana,orange,plum
b,apple,berry,orange,grapefruit
c,melon,berry,kiwi

Any help would be appreciated

This code works but is way too slow. I have to cycle through 300000 entries.

Dim MyVar As String
Dim Col
Dim Var

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

    ' Select first line of data.
  For Var = 1 To 132536
  Sheets("Line Item Detail").Select
  Range("G2").Select
  ' Set search variable value.
  Var2 = "A" & Var

  MyVar = Sheets("Sheet1").Range(Var2).Value

  'Set Do loop to stop at empty cell.
  Col = 1
  Do Until IsEmpty(ActiveCell)
     ' Check active cell for search value.
     If ActiveCell.Value = MyVar Then

        Col = Col + 1
        Sheets("Sheet1").Range(Var2).Offset(0, Col).Value = ActiveCell.Offset(0, 1).Value


     End If
     ' Step down 1 row from present location.
     ActiveCell.Offset(1, 0).Select
  Loop
  Next Var

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True

Answer 1

Sorry I can't be more helpful, I don't have Excel handy.

Here is a related thread on the subject, using VBA:

http://www.mrexcel.com/forum/showthread.php?t=459716

And the snippet from that thread:

Function MultiVLookup(rngLookupValues As Range, strValueDelimiter As String, rngLookupRange As Range, TargetColumn As Integer) As String
Dim varSplitValues As Variant, varItem As Variant, strResult As String, i As Integer, varLookupResult As Variant

varSplitValues = Split(rngLookupValues, strValueDelimiter, -1, vbTextCompare)

For Each varItem In varSplitValues

    On Error Resume Next
    varLookupResult = Application.WorksheetFunction.VLookup(varItem, rngLookupRange, TargetColumn, False)

    If Err.Number <> 0 Then
        strResult = strResult & "#CompanyNameNotFound#"
        Err.Clear
    Else
        strResult = strResult & varLookupResult
    End If
    On Error GoTo 0

    If UBound(varSplitValues) <> i Then
        strResult = strResult & ", "
    End If
    i = i + 1
Next varItem

MultiVLookup = strResult

End Function

Answer 2

Could you give this a shot?

ThisWorkbook.Sheets("Sheet1").Cells.ClearContents
intKeyCount = 0
i = 1

' loop till we hit a blank cell
Do While ThisWorkbook.Sheets("Line Item Detail").Cells(i, 1).Value <> ""
    strKey = ThisWorkbook.Sheets("Line Item Detail").Cells(i, 1).Value

    ' search the result sheet
    With ThisWorkbook.Worksheets("Sheet1")
    For j = 1 To intKeyCount

        ' we're done if we hit the key
        If .Cells(j, 1).Value = strKey Then
            .Cells(j, 2).Value = .Cells(j, 2).Value + 1
            .Cells(j, .Cells(j, 2).Value).Value = ThisWorkbook.Sheets("Line Item Detail").Cells(i, 2).Value
            Exit For
        End If
    Next

    ' new key
    If j > intKeyCount Then
        intKeyCount = intKeyCount + 1
        .Cells(j, 1).Value = strKey
        .Cells(j, 3).Value = ThisWorkbook.Sheets("Line Item Detail").Cells(i, 2).Value
        ' keep track of which till which column we filled for the row
        .Cells(j, 2).Value = 3
    End If
    End With

    i = i + 1
Loop

' delete the column we used to keep track of the number of values
ThisWorkbook.Worksheets("Sheet1").Columns(2).Delete

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

Answer 3

There is a pivot table-based approach you might want to consider.

Create a pivot table (if using Excel 2007, use the "classic" format) with both of your fields in the Row Labels area. Remove subtotals and grand totals. This will give you a unique list of all values for each of the categories. You can then copy and paste values to get your data in this format:

a   apple
    bannana
    orange
    plum
b   apple
    berry
    grapefruit
    orange
c   berry
    kiwi
    melon

All your unique values are now compactly displayed and you can use VBA to loop through this smaller subset of data.

If you need any help with the VBA for the pivot table creation, let me know.

Answer 4

Your code is a good starting point. Couple things to speed it up.

Instead of using ActiveCell and SelectValue just change values directly like this:

Sheet1.Cells(1, 1) = "asdf"

Also, sort your sheet on the first (key) column before you start your loops (there is a VBA Sort method if you need to do this programatically). It might take a little time but will save you in the long run. Then your Do Until IsEmpty inner loop only has to go until the value of the key changes instead of through the entire data set every time. This reduces your run time an order of magnitude.

UPDATE
I have included some code below. It ran in about a minute for 300K random data lines. The sort took about 3 seconds. (I have a normal desktop - approx 3 years old).

Sort in VBA as follows Sheet1.Range("A1:B300000").Sort key1:=Sheet1.Range("A1"). You can also replace the Range param with two Cell params (see Excel help for examples).

Code for the processing. You might want to parameterize the sheet - I just hardcoded it for brevity.

    Dim LastKey As String
    Dim OutColPtr As Integer
    Dim OutRowPtr As Long
    Dim InRowPtr As Long
    Dim CurKey As String

    Const KEYCOL As Integer = 1         'which col holds your "keys"
    Const VALCOL As Integer = 2         'which col holds your "values"
    Const OUTCOLSTART As Integer = 4    'starting column for output

    OutRowPtr = 0   'one less than the row you want your output to start on
    LastKey = ""
    InRowPtr = 1    'starting row for processing

    Do
        CurKey = Sheet2.Cells(InRowPtr, KEYCOL)
        If CurKey <> LastKey Then
            OutRowPtr = OutRowPtr + 1
            LastKey = CurKey
            Sheet2.Cells(OutRowPtr, OUTCOLSTART) = CurKey
            OutColPtr = OUTCOLSTART + 1
        End If

        Sheet2.Cells(OutRowPtr, OutColPtr) = Sheet2.Cells(InRowPtr, VALCOL)
        OutColPtr = OutColPtr + 1
        InRowPtr = InRowPtr + 1

    Loop While Sheet2.Cells(InRowPtr, KEYCOL) <> ""

Answer 5

This can be done by hand in less than 1 minute using pivot table and grouping.

• create a pivot with the fruits as the row fields (the leftmost column)
• move drag the fruits you want to group next to each other
• to group, select the cells in the leftmost column, and select Group from the PivotTable menu
• repeat previous point for each group

Now that you can do it the efficient way "by hand", record it, and rewrite it properly, and you may end up with efficient code, using the facilities of its environment (Excel).