Formula needed to copy certain data from Rows to Columns

[txart]

I am sure this is a simple fix for the experienced Excel user... and I apologize if this is explained in other threads. I could not find what I needed after two hours of searching. Anyhow... here it is... I have a file that is over 400,000 fields by two. A small portion of the file looks like:

A B
1 214570 porch
2 214570 realism
3 214570 red
4 214570 rocking
5 214570 rocking chairs
6 214570 traditional
7 51528 aa ap115
8 51528 abstract
9 51537 aa ap170
10 51537 alfred
11 51537 arrangement
12 51537 blue
13 51537 contemporary
14 51537 cornflower
.... and so on for 400,000 more fields

What I need to do is collect the data so the sku number is field A is not repeated and the info in B is collected all in one cell. So, it would look something like:

A B
1 214570 porch, realism, red, rocking, etc.
2 51528 aa ap115, abstract
3 51537 aa ap170, alfred, arrangement, etc


This seems easy to do... but I can't figure out a way. Your help would be greatly appreciated. Thanks.

 

[GTO]

Are you okay with macros?

 

[txart]

I've done that only once a few years ago.... I am sure I can do it if you walk me through it. Thanks for the quick reply!!

 

[Robert Mika]

If you work in Excel 07 or 10 (they have 16384 column in case you will have more that 256 (columns in Excel 2003) words in returned)
You can use formula from this topic adjusted to your needs:

http://www.mrexcel.com/forum/showthread.php?p=2263339#post2263339



an then use MCONCAT
from the Morefunc add- in to concatened all your cell into one.
But I would go with GTO suggestion as with 400 000 rows that may take a little while to calculate.

 

[txart]

Thank you for the reply Robert.... but that is a bit over my head. Can you show me exactly what to enter into a cell? I really do appreciate your help.

 

[Rick Rothstein]

Here is a macro that should do what you want....

Sub TransposeData()
  Dim LastRow As Long, A As Range
  Const StartRow As Long = 1
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  On Error Resume Next
  With Cells(StartRow - (StartRow = 1), "C").Resize(LastRow - StartRow + 1)
    .FormulaR1C1 = "=if(rc1=r[-1]c1,""X"","""")"
    .Value = .Value
    For Each A In .SpecialCells(xlConstants).Areas
      A(1).Offset(-1).Resize(, A.Count) = WorksheetFunction.Transpose(A.Offset(, -1))
    Next
    .Replace "X", "=X", xlWhole
    .SpecialCells(xlFormulas).EntireRow.Delete
  End With
  Application.ScreenUpdating = True
End Sub

To install this macro, press ALT+F11 from any worksheet to go into the VB editor, then click Insert/Module on its menu bar once there... this will open up a code window... copy the above code into that code window. That is it... you are done. Go back to the worksheet with your data on it and press ALT+F8 to bring up the macro selection dialog box... select TransposeData in the list and then press the Run button. Your data should now be transposed.

 

[GTO]

Well... I didn't take into account the sku's being sorted, Rick's may be a lot faster...

FWIW, here is what I came up with:

Excel Workbook
	A	B	C	D	E
1	HDR	HDR		HDR	HDR
2	214570	porch		214570	porch, realism, red, rocking, rocking chairs, traditional
3	214570	realism		51528	aa ap115, abstract
4	214570	red		51537	aa ap170, alfred, arrangement, blue, contemporary, cornflower
5	214570	rocking
6	214570	rocking chairs
7	214570	traditional
8	51528	aa ap115
9	51528	abstract
10	51537	aa ap170
11	51537	alfred
12	51537	arrangement
13	51537	blue
14	51537	contemporary
15	51537	cornflower
Sheet4

In a Standard Module:

Option Explicit
    
Sub exa1()
Dim DIC         As Object '<--- Dictionary
Dim wks         As Worksheet
Dim rngData     As Range
Dim aryData     As Variant
Dim aryOutput   As Variant
Dim Items       As Variant
Dim Keys        As Variant
Dim i           As Long
    
    '// Set a reference to a dictionary object                                  //
    Set DIC = CreateObject("Scripting.Dictionary")
    
    '// Set reference to the sheet; NOTE: change sheetname to suit.             //
    Set wks = ThisWorkbook.Worksheets("Sheet4")
    With wks
        '// This presumes data starts in Col A, at row 2, change to suit        //
        Set rngData = Range(.Cells(2, 1), .Cells(.Rows.Count, 2).End(xlUp))
    End With
    '// Plunk that stuff (both columns) into an array.                          //
    aryData = rngData.Value
    '// Size our output array to match.  ie - 1 to n rows, by 1 to 2 columns    //
    ReDim aryOutput(1 To UBound(aryData, 1), 1 To 2)
    
    '// Run down our first 'column' in input array...                           //
    For i = 1 To UBound(aryData, 1)
        '// Read vba help topics for Dictionary.  In gist - using .Item(Key)    //
        '// will create a new unique key if we haven't used the sku before, OR, //
        '// if the key already exists, then the key's corresponding item will   //
        '// be updated.  In our case, the first time we run into a particular   //
        '// sku, we'll define the item as Empty & sku# & comma-space.           //
        '// Therafter, whatever item has in it thus far, gets appended.         //
        '// Personally, I think of key as a word and item as the word's         //
        '// definition.  There will be only one instance of a given key (word)  //
        '// but several keys (words) could have the same value in the           //
        '// key's corresponding item (like several different words could mean   //
        '// the same thing).                                                    //
        DIC.Item(aryData(i, 1)) = DIC.Item(aryData(i, 1)) & aryData(i, 2) & ", "
    Next
    
    '// Back on task... The number of keys and items will always be the same of //
    '// course, so we'll use parallel arrays.                                   //
    Keys = DIC.Keys
    Items = DIC.Items
    
    '// Now the array we grabbed from the range is 1-based (and we made the     //
    '// output array the same size and 1-based as well), but DIC.Keys and       //
    '// DIC.Items are 0-based.  Hence the +1                                    //
    For i = 0 To UBound(Keys)
        aryOutput(i + 1, 1) = Keys(i)
        aryOutput(i + 1, 2) = Left(Items(i), Len(Items(i)) - 2)
    Next
    '// Now, aryOutput's 'rows' will mostly be empty, so if you decide to fix   //
    '// in place, this clears the unneeded values.                              //
    rngData.Offset(, 3).Value = aryOutput      '<--to offset as in example
    'rngData.Value = aryOutput                   '<--to overwrite in place
End Sub

 

[Rick Rothstein]

After reading GTO's code, I realized my previously code doesn't do exactly what you asked for... you wanted a comma delimited list in one cell (Column B) whereas I gave you each item in its own cell along the row. Here is corrected code (it should still be quite fast when executing) that creates the comma delimited list you asked for...

Sub TransposeData()
  Dim LastRow As Long, A As Range
  Const StartRow As Long = 1
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  On Error Resume Next
  With Cells(StartRow - (StartRow = 1), "C").Resize(LastRow - StartRow + 1)
    .FormulaR1C1 = "=if(rc1=r[-1]c1,""X"","""")"
    .Value = .Value
    For Each A In .SpecialCells(xlConstants).Areas
      A(1).Offset(-1, -1) = Join(WorksheetFunction.Transpose(A.Offset(-1, -1).Resize(A.Count + 1)), ", ")
    Next
    .SpecialCells(xlConstants).EntireRow.Delete
  End With
  Application.ScreenUpdating = True
End Sub

 

[txart]

You guys are amazing... I tried the first macro and it did not work... I am not trying the other two suggestions... I will let you know what happens.

 

[txart]

I don't know what I'm doing wrong.... but I can't get either formula to work. I went through the process of hitting alt + f11... Insert, Module.. back to the worksheet and hit alt + f8..... no luck. One formula deletes everything and the other does nothing. What am I doing wrong?