Selecting cells formula - Problably simple

[jd]

Hi, I've foolishly volunteered to help someone out with flattening a
number of database tables into a single spreadsheet, and my minor
level of Excel knowledge is hindering me in what I'd think would be a
simple task.

To illustrate my problem consider the following tables (might look
better in a fixed width font)

ID Name Fruits
1 James
2 Paul
3 Frances

A list of Names and their corresponding Identifiers, obviously. And an
empty column labeled 'fruits'.
Then, we have another table which maps the various person-IDs to the
fruit they like...

ID Fruit
1 Apple
1 Pear
1 Orange
2 Apple
2 Orange
3 Pear

....so, for example, James likes apples and pears, while Frances only
likes pears.

I'd ideally like the Fruits column in the first table to contain some
string contatonation of the various fruits that person likes,
something similar to the following:

ID Name Fruits
1 James Apple,Pear,Orange
2 Paul Apple,Orange
3 Frances Pear

If this was stored in a database, I'd have no trouble getting the data
with SQL, and no problem if it was in some kind of multi-dimensional
array in C or C#, but using Excel formulas, I'm completely stumped.

So far I've tried playing around with LOOKUP, and VLOOKUP, some stuff
with CELL, and some IFs. Is there anyone that can suggest just the
name of some functions I should be looking at?

Many thanks in advance.

JD

 

[Dave Peterson]

I'm not sure you could do this using plain old formulas--I know that I couldn't.

I'd use a macro.

If you want to try:

Option Explicit
Sub testme()

Dim OrigWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim TablWks As Worksheet
Dim res As Variant
Dim MatchCell As Range
Dim myStr As String

Set OrigWks = Worksheets("sheet1")
Set TablWks = Worksheets("sheet2")

With OrigWks
Set myRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With TablWks
With .Range("A:B")
.Cells.Sort key1:=.Columns(1), order1:=xlAscending, _
key2:=.Columns(2), order2:=xlAscending, _
header:=xlYes
End With
End With

For Each myCell In myRng.Cells
res = Application.Match(myCell.Value, TablWks.Columns(1), 0)
If IsError(res) Then
'no match, done with this one
Else
myStr = ""
Do
Set MatchCell = TablWks.Cells(res, "A")
myStr = myStr & "," & MatchCell.Offset(0, 1).Value
If MatchCell.Offset(1, 0).Value = MatchCell.Value Then
res = res + 1
Else
Exit Do
End If
Loop
If myStr <> "" Then
myStr = Mid(myStr, 2)
End If
myCell.Offset(0, 2).Value = myStr
End If
Next myCell
End Sub

If you're new to macros:

Debra Dalgleish has some notes how to implement macros here:
http://www.contextures.com/xlvba01.html

David McRitchie has an intro to macros:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Ron de Bruin's intro to macros:
http://www.rondebruin.nl/code.htm

(General, Regular and Standard modules all describe the same thing.)

 

[jd]

I'm not sure you could do this using plain old formulas--I know that I couldn't.

Dave Peterson

Damn. I thought I might be able to avoid VB Macros, nevermind. Many
thanks for your help and source code Dave, and especially the Macro
tutorial links, I'm sure I'll have something up and running in no
time.

Many thanks again.