Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Another sorting question in Excell

Status
Not open for further replies.

fanch72

IS-IT--Management
Mar 7, 2003
65
SE
Hi!

I have a table with something like 1500 rows. Each row has two columns. On the first one there is the name of a person, on the second on a certain attribute for this person. One person can have several attributes so next row could be name1 attribute2. In total there are something like 500 names and 150 attributes. The problem is the following: I have another list of 44 names and I want to identify all the attributes for these names in separate columns each name. Can someone help me? Thanks in advance!!!
Regards

Francois

Here is how the table looks like:


A B C
1 name1 attribute1 name1
2 name1 attribute2 name3
3 name2 attribute1 name4
4 name2 attribute4
5 name2 attribute5
6 name3 attribute4
7 name3 attribute6
8 name5 attribute1
9 name5 attribute2
10 name6 attribute8

A B C
1 name1 name3 name4
2 attribute1 attribute4
3 attribute2 attribute6


 
I assume you know how to use Copy/Paste Special...Transpose to get the list of names from column C.

In this example, I put the names in D1 thru F1.

First put this function in a code module:
[blue]
Code:
Option Explicit

Function VLOOKUPNEXT(lookup_value, table_array As Range, _
           col_index_num As Integer, last_value)
[green]
Code:
' Extension to VLOOKUP function.  Allows for finding
' the "next" item that matches the lookup value.
[/color]
Code:
Dim nRow As Long
Dim bFound As Boolean
  VLOOKUPNEXT = ""
  With table_array
    For nRow = 1 To .Rows.Count
      If .Cells(nRow, 1).Text = lookup_value Then
        If bFound = True Then
          VLOOKUPNEXT = .Cells(nRow, col_index_num).Text
          Exit Function
        Else
          If .Cells(nRow, col_index_num).Text = last_value Then
            bFound = True
          End If
        End If
      End If
    Next nRow
  End With
End Function
[/color]

Then set up the worksheet this way:
[blue]
Code:
D1: 'name1
E1: 'name2
F1: 'name3
D2: =VLOOKUP(D$1,$A$1:$B$10,2,0)
E2:   (copy from D2)
F2:   (copy from D2)
D3: =VLOOKUPNEXT(D$1,$A$1:$B$10,2,D2)
[/color]

Now copy the formula from D3 into D3:F10

 
Hi fanch72,

Just did this for a bit of fun, and to learn, myself. Hope it suits.

Assuming your first list (of 1500) is in columns A and B and starts with the column headings in Row 1 – as shown in your example. Also assuming that your second list (of names) is in Column C and also starts with column headings in Row 1 – again, as shown in your example.

The following code will produce the list(s) you want in Columns E through as many columns as it takes (up to the Excel maximum which you are nowhere near with your quoted figures). You can put it anywhere you want but note that the code uses a column to the left of it as workspace.

Code:
Dim tjNumNames As Integer
Dim tjMaxRow As Integer
Dim tjCol As Integer
Code:
' Insert a blank first row to keep Advanced Filter happy
Code:
Rows("1:1").Insert Shift:=xlDown
Code:
' Find length of list which now starts in Column C Row 2
Code:
tjNumNames = Range("C2").End(xlDown).Row - 2
Code:
' Copy list from Column C to Row 2
Code:
Range("C3:C" & tjNumNames + 2).Copy
Range("E2").PasteSpecial Transpose:=True
Application.CutCopyMode = False
Code:
' Copy column name above each - for criteria - see later
Code:
Range("A2").Copy Destination:=Range(Cells(1, 5), Cells(1, tjNumNames + 4))
Application.CutCopyMode = False

tjMaxRow = 0
Code:
' Working from Right to Left ...
Code:
For tjCol = tjNumNames + 4 To 5 Step -1
Code:
' Don't know why this is needed!
Code:
    Range(Cells(3, tjCol - 1), Cells(3, tjCol)).ClearContents
Code:
' Filter the big list and copy the results
Code:
    Range("A2:B12").AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Range(Cells(1, tjCol), Cells(2, tjCol)), _
            CopyToRange:=Range(Cells(3, tjCol - 1), Cells(3, tjCol))
Code:
' Save last row used - if biggest so far
Code:
    If Cells(3, tjCol - 1).End(xlDown).Row > tjMaxRow Then _
        tjMaxRow = Cells(3, tjCol - 1).End(xlDown).Row

Next
Code:
' Tidy up - clear Row 3 and Column 4 and delete Row 1
Code:
Range(Cells(4, 5), Cells(tjMaxRow, tjNumNames + 4)).Cut Destination:=Cells(3, 5)
Columns("D:D").ClearContents
Rows("1:1").Delete Shift:=xlUp

Enjoy,
Tony
 
I did something very similar the other week. The solution that I came up with (with some help from several kind tipsters at Tek-Tips) was to go to the worksheet and place the person name in a cellas you have in your second example. Then do the following.

A
1 Name1
2 =index('first sheet'!$B:$B,match(A$1,'first sheet'!$A:$A,0))
3 =if(index('first sheet'!$B:$B,match(A$1,'first sheet'!$A:$A,0)+1)=A$1,index('first sheet'!$B:$B,match(A$1,'first sheet'!$A:$A,0)+1),"")
4 =if(index('first sheet'!$B:$B,match(A$1,'first sheet'!$A:$A,0)+2)=A$1,index('first sheet'!$B:$B,match(A$1,'first sheet'!$A:$A,0)+2),"")
5 =if(index('first sheet'!$B:$B,match(A$1,'first sheet'!$A:$A,0)+3)=A$1,index('first sheet'!$B:$B,match(A$1,'first sheet'!$A:$A,0)+3),"")
...

And Continue likewise down the column. Also note, that although the next may wrap on the post, the entire formula goes in one cell on each row. Will also have to substitute the appropriate worksheet name for 'first sheet'.

What that does, essentially, is keep listing attributes as long as the name matches the name at the top of the colum. You can then drag it across and it will change the A$1 to B$1, C$1, etc. automatically.

The only limitation of this is that it requires that your list be sorted by name. In other words, all of name 1's attributes have to be listed in order. If not, it will find everything that follows the first one but it may or may not find the others.

I used this to create team lists (i.e. Everyone on Bob Smith's team is listed under his name, etc)

Hope this helps.

CP
 
Thank you for your help guys!

Francois
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top