I wish to find keywords across multiple columns in a single row and then list them in a single cell in comma separated values...

Hi Excel Wizards...

I've got the following table with an Image ID followed by columns (and various amounts) of keywords:
(this table is huge and cannot be reformatted)

IMAGE ID            KEYWORDS
00101-80001-16      -- Ocean Sand --      Environment      Nature      -- 060315 --      
01200-30052-70      -- Hawaiian --      Hawaiian      Culture      Cultural      -- Printscapes --      -- Fine Art --
10018-30194-76      -- Ocean Sand --      Environment      Nature      -- Printscapes --      -- Fine Art --
10071-30455-16      -- Health Beauty --      Concept            Oahu      Hawaiian Islands      Pacific



I've also got a column of predefined words I need to find (on a separate sheet for now, this can be reformatted into rows or csv if need be):
-- Ocean Sand --
Nature
-- Fine Art --



OBJECTIVE:  I would like to add a column called LIST that can displays predefined words (if they exist) as comma separated values in a single cell.

The output would appear like so:

IMAGE ID            LIST
00101-80001-16      -- Ocean Sand --, Nature      
01200-30052-70      -- Fine Art --
10018-30194-76      -- Ocean Sand --, Nature, -- Fine Art --
10071-30455-16      


HELP!  Mahalo for your time!
Krissy
LVL 1
trixitsAsked:
Who is Participating?
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.

Glenn_MooreCommented:
You can create a subroutine that searches for matches and then cancatineates the values.  
The following code checks for matches and concatintes the text palced in column B:
       For r2 = 2 To wsssource          'Cycling through the data for the update components
        For r1 = 2 To wsssmatch    'cycling through the taxonomy to find matches
         If Trim(wsMatch.Cells(r1, 3)) = Trim(wsSource.Cells(r2, 7)) And Len(Trim(wsSource.Cells(r2, 3))) <> 0 Then     'Found a match
          Sheets("Update").Select                             'generates the first part of the Update component
           wsUpdate.Cells(r3, 1) = wsSource.Cells(r2, 3)
            wsUpdate.Cells(r3, 2) = wsMatch.Cells(r1, 1) & "/" & wsSource.Cells(r2, 8) & "/A "
             r5 = r1 + 1
              r6 = r2 + 1
mxxx:             Do While wsSource.Cells(r2, 3) = wsSource.Cells(r6, 3) 'checks the next record for matching email address
                 For r5 = 2 To wsssmatch  'cycles through to find matches
                If Trim(wsMatch.Cells(r5, 3)) = Trim(wsSource.Cells(r6, 7)) And wsSource.Cells(r2, 3) = wsSource.Cells(r6, 3) And r5 < wsssmatch Then
               wsUpdate.Cells(r3, 2) = wsUpdate.Cells(r3, 2) & wsMatch.Cells(r5, 1) & "/" & wsSource.Cells(r6, 8) & "/A " 'cancatinates the additional matching components
              r6 = r6 + 1
             r5 = 1  'finished the cancatination of the record, restart the taxonomy at the beginning for the next individual.
            End If
           If r5 = wsssmatch Then  'If the skill does not match, go to the next one
           r6 = r6 + 1: GoTo mxxx: End If
           Next r5
          Loop 'checks for next matching email address
         r3 = r3 + 1
        End If
       Do While Len(Trim(wsSource.Cells(r2, 3))) = 0 'skips all records without email address
        r2 = r2 + 1: r6 = r6 + 1     'increments both counters used with wsSource
       Loop
     If r1 = wsssmatch Then 'If the first record of the group does not have a match, increment to the next data record
    r2 = r2 + 1: r6 = r2: End If 'Trick the counters to reset appropriately
   r2 = r6
  Next r1
 On Error GoTo handlecancel
Next r2
handlecancel:   Sheets("Directions").Select                            'Returning to the original worksheet
Glenn
trixitsAuthor Commented:
Wow, Glenn.  That was very fast!   Thanks for the comment...

I'm sorry, I should have also mentioned that I'm a noob and I have no idea how to use what you've given me above.  

How do I use it?
zorvek (Kevin Jones)ConsultantCommented:
This macro is a little easier to use. Add it to any general module, activate the sheet with the master list, make sure there is an unused column after the IMAGE ID column and before the KEYWORDS columns, and run the macro. It will ask you to select the list of special phrases.

To add VBA code to a regular module in an Excel workbook, press ALT+F11 to open the VBA development environment (VBE). Select the menu command Insert->Module to create a new VBA module. Paste the code into the document window that appears. Press ALT+F11 to return to the Excel workbook.

To run a macro from Excel, select the menu command Tools->Macro->Macros or press ALT+F8. A dialog box appears listing all available macros. Find the desired macro and select it. Click the Run command button to start the macro.

Public Sub CleanList()

   Dim MasterList As Range
   Dim PhrasesList As Range
   Dim Row As Range
   Dim Phrases As Variant
   Dim Phrase As Variant
   Dim OriginalList As String
   Dim NewPhraseList As String
   
   Set MasterList = ActiveSheet.UsedRange
   On Error Resume Next
   Set PhrasesList = Application.InputBox("Select the phrase list to use", "Select Phrase List", Type:=8)
   On Error GoTo 0
   If PhrasesList Is Nothing Then Exit Sub
   Phrases = Application.Transpose(PhrasesList)
   For Each Row In MasterList.Resize(MasterList.Rows.Count - 1).Offset(1).Rows
      OriginalList = Join(Application.Transpose(Application.Transpose(Row.Cells(1, 3).Resize(ColumnSize:=MasterList.Columns.Count - 2))), "|")
      NewPhraseList = ""
      For Each Phrase In Phrases
         If InStr(OriginalList, Phrase) > 0 Then NewPhraseList = NewPhraseList & IIf(Len(NewPhraseList) > 0, ", ", "") & Phrase
      Next Phrase
      Row.Cells(1, 2).Value = NewPhraseList
   Next Row
   
End Sub

Kevin

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
trixitsAuthor Commented:
OH MY GAWD...

KEVIN, THANK YOU!  You are a Experts-Exchange GENIUS!

How much I love you I cannot explain.  Bless your beautiful mind.  :)

(Glenn, thanks for your effort too!)
zorvek (Kevin Jones)ConsultantCommented:
I can die happy now.
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.