Quick help needed...

B

BAW

Hi All,
I've been reviewing many entries in the forum to help me complete a task
I signed up for. Although I have learn much from the many responses I still
haven't solved my specific problem. I'm sure I could if time permitted but
now I'm under the gun to complete. I have a long list of names of
volunteers and a long list of activities the voluteers can signup for. Want
I want to do is create a listing of the voluteers and what they volunteered
for without having to re-type all the activities for each voluteer. Here
are the table layouts:

Table A - each volunteer identified by number in Col A.
A B C D
Name Activities
1 Volunteer 1
2 Volunteer 2
3 Volunteer 3
4 Volunteer 4
5 Volunteer 5

Table B - A list of activities with index numbers of all the volunteers to
the cells on the right.
A B C D E F G
Activities
Animal Science 1
Archaeology 3 5
Archery 2 1 4 5 3
Architecture 5 3 4
Art 2 3 1

What I would like to do for each voluteer is search the activities in Table
B for all the activities assigned and input the list of activities (separated
by ",") in column "b" next to the volunteers name in Table A.
 
O

Otto Moehrbach

BAW
The following macros will do what you need, if I understand you
correctly. I assumed your table 1 is starting in Column A, with headers in
row 1 and data starting in row 2. I also assumed you table 2 is starting in
Column D with headers in row 8 and data starting in row 9. You will need to
change the code to match your layout.
If you wish, send me an email, identifying yourself as BAW, and I'll send
you the small file I used for this. HTH Otto
Option Explicit
Dim RngListOfVolNums As Range
Dim RngListActivities As Range
Dim i As Range
Dim k As Range
Dim RngOfActivitiesNums As Range 'Rng of numbers to right of the activities
list
Dim FoundNum As Range

Sub GetActivites()
Call GetRngs
Call GetActivityNums
End Sub

Sub GetRngs()
Set RngListOfVolNums = Range("A2", Range("A" & Rows.Count).End(xlUp))
Set RngListActivities = Range("D9", Range("D" & Rows.Count).End(xlUp))
End Sub

Sub GetActivityNums()
For Each i In RngListActivities
If Not IsEmpty(i.Offset(, 1)) Then
Set RngOfActivitiesNums = _
Range(i.Offset(, 1), Cells(i.Row, Columns.Count).End(xlToLeft))
For Each k In RngOfActivitiesNums
Set FoundNum = RngListOfVolNums.Find(What:=k.Value,
LookAt:=xlWhole)
If IsEmpty(FoundNum.Offset(, 2).Value) Then
FoundNum.Offset(, 2).Value = i.Value
Else
FoundNum.Offset(, 2).Value = _
FoundNum.Offset(, 2).Value & _
", " & i.Value
End If
Next k
End If
Next i
End Sub
 
Top