Remove words from a cell that aren't in a list

I want to remove some words that aren't in a separate list from an excel list. Someone gave me an example with Find/Replace, but i need the exact opposite, meaning that i want to keep the words in the list and remove the other. Also if a word is removed, I would have more than 1 space开发者_StackOverflow so i would need to remove multiple spaces.

Can anyone give me an example?

Thanks, Sebastian

EDIT

Initial cell contents: word1 word2 word3 word4

Cell contents after script: word2 word4

My list contains: word2, word4, word7, ...

This works:

Sub words()
    Dim whitelist() As Variant
    Dim listToScreen As Variant
    Dim screenedList As String
    Dim itsInTheWhitelist As Boolean
    Dim i As Long
    Dim j As Long

    ' Words to keep
    whitelist = Array("word2", "word4", "word7")

    ' Input old cell contents, split into array using space delimiter
    listToScreen = Split(Range("A1").Value, " ")

    screenedList = ""
    For i = LBound(listToScreen) To UBound(listToScreen)

        ' Is the current word in the whitelist?
        itsInTheWhitelist = False
        For j = LBound(whitelist) To UBound(whitelist)
            If listToScreen(i) = whitelist(j) Then
                itsInTheWhitelist = True
                Exit For
            End If
        Next j

        If itsInTheWhitelist = True Then
            ' Add it to the screened list, with space delimiter if required
            If Not screenedList = "" Then
                screenedList = screenedList & " "
            End If
            screenedList = screenedList & listToScreen(i)
        End If
    Next i

    'Output new cell contents
    Range("A2").Value = screenedList

End Sub

Using a Scripting.Dictionary and a RegExp will cost two references, but will avoid a N*N loop:

' needs ref to Microsoft Scripting Runtime,
' Microsoft VBScript Regular Expressions 5.5

Option Explicit

Sub frsAttempt()
  Dim sInp As String: sInp = "word1 word2 word3 word4"
  Dim aInp As Variant: aInp = Split(sInp)
  Dim sExp As String: sExp = "word2 word4"
  Dim sLst As String: sLst = "word2, word4, word7"
  Dim aLst As Variant: aLst = Split(sLst, ", ")
  Dim dicGoodWords As New Dictionary
  Dim nIdx
  For nIdx = 0 To UBound(aLst)
    dicGoodWords(aLst(nIdx)) = 0
  Next
  For nIdx = 0 To UBound(aInp)
      If Not dicGoodWords.Exists(aInp(nIdx)) Then
         aInp(nIdx) = ""
      End If
  Next
  Dim sRes As String: sRes = Join(aInp)
  Dim reCleanWS As New RegExp
  reCleanWS.Global = True
  reCleanWS.Pattern = "\s+"
  sRes = Trim(reCleanWS.Replace(sRes, " "))
  Debug.Print sExp
  Debug.Print sRes
  Debug.Print sRes = sExp
End Sub

Output:

word2 word4
word2 word4
True

The dictionary could be filled from a WorkSheet's column.