Search fields in 4 sheets and return value in adjacent columns

I have 4 sheets

LISTA, LISTB, LISTC, LISTD

Each list is very simple.. it contains a list of word (COL A) and number of times used (COL B)

i.e

LISTA

Kitten 23
Director 56
Social 11

Open in new window


LISTB
Director 123
Netflix 23

Open in new window


and so on

These words lists are not exactly the same, but can contain COMMON words

I need to add a fifth sheet that will (here goes)

Grab a list of every word used, and make a list of DISTINCT WORDS
then next to it have TIMES USED for each list

So using the list above we would have a list of  

Kitten      23     0
Director  56     123
Social       11    0
Netflix     0      23

Open in new window


To be honest the distinct part of not that important (though would be really really nice) as I can just feed in lists.. but the counting part is key

Is this possible without a macro? I was using this page as a guide and getting partial success.. but it was messy and didnt make the nice layout I required

http://www.get-digital-help.com/2012/03/28/search-for-a-text-string-and-return-multiple-adjacent-values/

Open in new window

LVL 3
mvwmailAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may try something like this......
The following code will create a Summary sheet in the workbook and will contain the desired output after the code is run.
Sub CombinedList()
Dim Summary As Worksheet, ws As Worksheet
Dim slr As Long, lr As Long, c As Long
Dim sRng As Range, Cell As Range, fRng As Range

Application.ScreenUpdating = False
On Error Resume Next
Set Summary = Sheets("Summary")  'Assuming a Sheet named Summary already exists

If Err = 0 Then
   Summary.Cells.Clear
Else
   Worksheets.Add(before:=Sheets(1)).Name = "Summary"    'If Summary Sheet doesn't exist, it will be created
   Set Summary = ActiveSheet
End If

For Each ws In Worksheets
   If ws.Name <> "Summary" Then
      lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
      ws.Range("A1:A" & lr).Copy
      If Summary.Range("A1").Value = "" Then
         Summary.Range("A1").PasteSpecial xlPasteAll
      Else
         slr = Summary.Cells(Rows.Count, 1).End(xlUp).Row + 1
         Summary.Range("A" & slr).PasteSpecial xlPasteAll
      End If
   End If
Next ws
Summary.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
slr = Summary.Cells(Rows.Count, 1).End(xlUp).Row
Set sRng = Summary.Range("A1:A" & slr)
c = 2
For Each ws In Worksheets
   If ws.Name <> "Summary" Then
      For Each Cell In sRng
         Set fRng = ws.Range("A:A").Find(what:=Cell.Value, LookIn:=xlValues, lookat:=xlPart)
         If Not fRng Is Nothing Then
            Summary.Cells(Cell.Row, c) = fRng.Offset(0, 1)
         Else
            Summary.Cells(Cell.Row, c) = 0
         End If
      Next Cell
      c = c + 1
   End If
Next ws
Summary.Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Finished.", vbInformation
End Sub

Open in new window


Please find the attached workbook and click the button on LISTA sheet to get the desired output.
Create-Summary.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mvwmailAuthor Commented:
Absolutely brilliant! Thanks

The above three words don't emphasise how amazed I am at the quality of this answer
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome. Glad I could offer some help.
And thanks for the appreciation as well.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.