Microsoft Office excel 2007 - upgrade

Dear all, could you please help me with this task I need to accomlish in work. I have a long sheet with the columns and rows as follows (table No. 1). In column A I have a product type (100A, 120A, 125A, etc.) I would like to put all these attributes next to it into the order that would be more clear - in the way to have all attributes for the same product in ONE line (please see the second table No.2). (there is no more then 5 same attributes for one product / see 145A - the max)

Could you please help me to solve this problem?

Many thanks to all of you,

Peter

Table No.1:

A / B / C

1 100A / cxa

2 100A / 724 / 2

3 120A / cxb

4 120A / 246 / 246

5 120A / 24 / 624

6 135A / cxb

7 135A / 62 / 4

8 140A / cxb

9 140A / 346 / 46

10 140A / 34 / 643

11 140A / 43 / 4

12 145A / cxa

13 145A / 52 / 35

14 145A / 32 / 3

15 145A / 3 / 532

16 145A / 5 / 7

Table no.2:

A B C D E F H I J K

1 100A cxa 724 2

2 120A cxb 246 246 24 624

3 135A cxb 62 4

4 140A cxb 346 46 34 643 43 4

5 145A cxa 52 35 32 3 3 532 5 7

The next time you need to post data in this forum, please read the How To referenced in my signature line. Click on the words How To. Here's what I did:

In Sheet2 Column A, I created a list of unique values from Sheet1 Column A, similar to what you have in

Table no. 2, except that I added a column label. That's important. You can create this list using Data...Filter...Advanced Filter.A 1 Items 2 100A 3 120A 4 135A 5 140A 6 145AI then ran this code and got the results you were looking for:

Option Explicit Sub SpecialTranspose() Dim listLen, rw, srcCol, lastSrcCol, nxtDstCol As Integer Dim firstAddress As String Dim c As Range 'Determine length of Filtered list listLen = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row 'Loop through list For rw = 2 To listLen With Sheets(1).Columns("A:A") 'Find values from Sheet2 in Sheet1 list Set c = .Find(Sheets(2).Cells(rw, 1), lookat:=xlWhole) firstAddress = c.Address Do 'Determine how many columns have data next to found item lastSrcCol = _ Sheets(1).Cells(c.Row, Columns.Count).End(xlToLeft).Column 'Loop trough columns For srcCol = 2 To lastSrcCol 'Determine next empty column for item on Sheet2 nxtDstCol = _ Sheets(2).Cells(rw, Columns.Count).End(xlToLeft).Column + 1 'Place next value from Sheet1 into next column on Sheet2 Sheets(2).Cells(rw, nxtDstCol) = Sheets(1).Cells(c.Row, srcCol) Next 'Find Next value if multiples exist Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End With Next End Sub

Posting Tip:Before posting Data or VBA Code, read thisHow-To.

Ask Your Question

Weekly Poll