Find Text From One Sheet and Populate Separate Sheet?

R

rdr06001

New Member
Joined
Apr 14, 2016
Messages
3
Hi everyone,

I'm trying to perform what I imagined would be a simple Excel task that is proving well-above my pay grade.

I have a spreadsheet with rows of projects and columns of multiple employees working on each. I have a second spreadsheet that has a row for each of the employees involved with projects on the previous sheet. I would like to set the workbook up so that second sheet pulls from the first sheet and self-populates.

I can't attach the file, so I've pasted an example for clarification purposes. The column headers are the employees area of specialty.

I've explored FIND, MATCH, VLOOKUP, HLOOKUP, etc. Any help you could offer would be much appreciated.

Thanks!
Ryan

SHEET 1

QC No.ProjectStrctArchArch 2Arch 3MechMech 2ElecElec 2Elec 3Ints
13780APhoFrazierAgliata Alicea FessahaieLopez
15196B PruittFrazier Alicea Lopez Horwood
15220C PruittFrazier Alicea Lopez Horwood
15365D Bechard Maheshwari Lopez Kyriacos
15399E Bechard Bustamante
XXXXXF Bechard BustamanteCrabb
14296G Bunting Harris
15285H Khan Alicea Atrifi
15371I Horwood
15056J Pho Atrifi
14484KPho
15238L Bechard Horwood
14931M AgliataFrazier Bustamante Lopez Roach
14949N FrazierKhan Bustamante Harris
14961OPhoFrazierPruitt Maheshwari Harris Kyriacos
14940P Kyriacos
15470Q AkinolaFrazier Bustamante Harris
15442R Bechard Grey
13672SPho
14863T AliceaGreyHarris
14769UPhoFrazier Crabb Harris
15354VPhoAkinolaFrazier
14928W Akinola Grey FessahaieLopez Horwood
15223X PruittWegmann Grey Atrifi
15091Y Fessahaie Kyriacos
15268Z Horwood
14565AA Kyriacos
15226BB Roach
14837CC BechardPruitt Bustamante Lopez Roach
15460DD Alicea Atrifi
14253EE Bustamante Atrifi
13907FF Bustamante Atrifi
14605GG Khan Maheshwari Atrifi
15209HH AgliataWegmann Pho Harris Kyriacos
14054II Kyriacos
15028JJ FrazierPruitt Bustamante Lopez Horwood
14856KK AkinolaWegmann Maheshwari FessahaieLopez Roach
15094LL Crabb
15355MM AgliataBechard LopezPho
15440NN Frazier Alicea Harris
15229OO Maheshwari Atrifi Kyriacos
14648PP BechardPruitt BustamanteMaheshwariLopezAtrifi
15266QQ AkinolaFrazier Alicea Harris Horwood
15282RR AkinolaFrazier Alicea Harris Horwood
14907SS Alicea
14836TT Khan AliceaFessahaieLopez
15287UU Khan Alicea LopezFessahaie
15207VV Wegmann Alicea Harris
15299WWPho Alicea
14924XX BechardKhan BustamanteMaheshwariHarris
14904YY BechardKhanPruittBustamanteMaheshwariFessahaieLopez Kyriacos
15295ZZ PruittFrazier BustamanteMaheshwariLopez Horwood
15185AAA AgliataWegmann Alicea Atrifi Horwood
15343BBB Horwood
15428CCC Lopez Kyriacos
15428DDD Kyriacos
15412EEE Bechard AliceaCrabbLopez
14919FFF Pho Atrifi
14929GGG Akinola Grey FessahaieLopez Horwood
14156HHH FrazierAkinola Maheshwari Atrifi Horwood
15413III FrazierPruitt
15309JJJ Kyriacos
14853KKK AliceaGreyHarris
15205LLL Wegmann Roach
15386MMM Horwood
15203NNN AgliataWegmann Lopez Roach
15340OOO AgliataBechard FessahaieHarris Roach

<colgroup><col><col><col span="4"><col span="2"><col><col span="2"><col></colgroup><tbody>
</tbody>


SHEET 2

DesignerProject 1 Project 2Project 3Project 4Project 5Project 6Project 7Project 8Project 9Project 10Project 11Project 12Project 13Project 14Project 15
Agliata
Akinola
Alicea
Atrifi
Bechard
Bunting
Bustamante
Crabb
Flores
Frazier
Gosset
Harris
Horwood
Khan
Kyriacos
Lopez
Maheshwari
PhoAKOSUVWWJHHFFFMM
Pruitt
Roach
Sydney
Wegman

<colgroup><col><col><col><col span="2"><col><col><col><col span="2"><col><col><col><col><col><col></colgroup><tbody>
</tbody>
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
Try this:
Code: 
Sub a934834()
'http://www.mrexcel.com/forum/excel-questions/934834-find-text-one-sheet-populate-separate-sheet.html
Dim d As Object, vx, i As Long, j As Long

vx = Range("B2", Cells(Rows.count, "L").End(xlUp)).Value
Set d = CreateObject("scripting.dictionary")

For j = 2 To 11
    For i = LBound(vx) To UBound(vx)
    If vx(i, j) <> vbNullString Then
        If Not d.Exists(vx(i, j)) Then
        d(vx(i, j)) = vx(i, 1)
        Else
        d(vx(i, j)) = d(vx(i, j)) & "," & vx(i, 1)
        End If
    End If
    Next
Next
sheets("sheet2").Range("A2").Resize(d.count, 2).Value = Application.Transpose(Array(d.Keys, d.Items))
sheets("sheet2").Range("B2").Resize(d.count, 1).TextToColumns DataType:=xlDelimited, _
 ConsecutiveDelimiter:=True, Comma:=True
End Sub
 
Upvote 0
Akuini said:
Try this:
Code: 
Sub a934834()
'http://www.mrexcel.com/forum/excel-questions/934834-find-text-one-sheet-populate-separate-sheet.html
Dim d As Object, vx, i As Long, j As Long

vx = Range("B2", Cells(Rows.count, "L").End(xlUp)).Value
Set d = CreateObject("scripting.dictionary")

For j = 2 To 11
    For i = LBound(vx) To UBound(vx)
    If vx(i, j) <> vbNullString Then
        If Not d.Exists(vx(i, j)) Then
        d(vx(i, j)) = vx(i, 1)
        Else
        d(vx(i, j)) = d(vx(i, j)) & "," & vx(i, 1)
        End If
    End If
    Next
Next
sheets("sheet2").Range("A2").Resize(d.count, 2).Value = Application.Transpose(Array(d.Keys, d.Items))
sheets("sheet2").Range("B2").Resize(d.count, 1).TextToColumns DataType:=xlDelimited, _
 ConsecutiveDelimiter:=True, Comma:=True
End Sub
Click to expand...

Thanks for your response. Perhaps I didn't enter the code correctly, but I got an error message saying that the "subscript out of range." Is there a way I can just send you the workbook?
 
Upvote 0
Upvote 0
Upvote 0
Your data structure is a bit different from your posted sample.
So the employee is from col C to M, right?
Try this code, see if this is what you want.
Code: 
Sub a934834e()
Dim d As Object, vx, i As Long, j As Long, rr As Long

rr = Range("B" & Rows.Count).End(xlUp).Row
vx = Range(Cells(2, "B"), Cells(rr, "M")).Value
Set d = CreateObject("scripting.dictionary")
For j = 2 To 12
    For i = LBound(vx) To UBound(vx)
    If vx(i, j) <> vbNullString Then
        If Not d.Exists(vx(i, j)) Then
        d(vx(i, j)) = vx(i, 1)
        Else
        d(vx(i, j)) = d(vx(i, j)) & "@@" & vx(i, 1)
        End If
    End If
    Next
Next
i = 1
For Each x In d
   i = i + 1
   Sheets("sheet2").Range("B" & i) = d(x)
Next
Sheets("sheet2").Range("A2").Resize(d.Count, 1).Value = Application.Transpose(Array(d.Keys))
Sheets("sheet2").Range("B2").Resize(d.Count, 1).TextToColumns DataType:=xlDelimited, other:=True, OtherChar:="@@", _
 ConsecutiveDelimiter:=True, Comma:=False
End Sub

I put the result in sheet2:
https://www.dropbox.com/s/5diamtb5rpkn16k/Reworked_Schedule1.xlsm?dl=0
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,215,943
Messages
6,127,814
Members
449,409
Latest member
katiecolorado

Share this page

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
Back
Top