Formula needed to copy certain data from Rows to Columns

txart

New Member
Joined
Oct 15, 2011
Messages
14
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.
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

txart

New Member
Joined
Oct 15, 2011
Messages
14
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

MrExcel MVP
Joined
Jun 29, 2009
Messages
7,256
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

New Member
Joined
Oct 15, 2011
Messages
14

ADVERTISEMENT

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

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,163
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Here is a macro that should do what you want....

Code:
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

MrExcel MVP
Joined
Dec 9, 2008
Messages
6,154

ADVERTISEMENT

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

FWIW, here is what I came up with:

Excel Workbook
ABCDE
1HDRHDRHDRHDR
2214570porch214570porch, realism, red, rocking, rocking chairs, traditional
3214570realism51528aa ap115, abstract
4214570red51537aa ap170, alfred, arrangement, blue, contemporary, cornflower
5214570rocking
6214570rocking chairs
7214570traditional
851528aa ap115
951528abstract
1051537aa ap170
1151537alfred
1251537arrangement
1351537blue
1451537contemporary
1551537cornflower
Sheet4


In a Standard Module:
Rich (BB code):
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

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,163
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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...

Code:
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

New Member
Joined
Oct 15, 2011
Messages
14
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

New Member
Joined
Oct 15, 2011
Messages
14
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?
 

Forum statistics

Threads
1,136,775
Messages
5,677,656
Members
419,708
Latest member
PhilD

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top