Use VBA to check whether cell contains words from another cell

Helient · May 5, 2023

I'd like a script that can tell whether words in each cell in one column (column A in attached image) are contained in one cell ($c$1). For ex., if A1 is Bed Tree, and C1 is Bed Desk Tree- > the code would recognize a match.

I have a few more criteria for the match that is included in the attached image (words repeat in order or out of order, plural vs singular match). Also, the script should not be case sensitive.

Thanks in advance.

rondeondo · May 10, 2023

Hi Henient,

this worsheet function will compare two cells and give any words from the second that are not present in the first. I expect you could change up the logic a little to suit your purposes.

VBA Code:

Function WORDDIF(strA As String, strB As String) As String

    Dim WordsA As Variant, WordsB As Variant
    Dim ndxA As Long, ndxB As Long, strTemp As String
        
    WordsA = Split(strA, " ")
    WordsB = Split(strB, " ")
    
    For ndxB = LBound(WordsB) To UBound(WordsB)
        For ndxA = LBound(WordsA) To UBound(WordsA)
            If StrComp(WordsA(ndxA), WordsB(ndxB), vbTextCompare) = 0 Then
                WordsA(ndxA) = vbNullString
                Exit For
            End If
        Next ndxA
    Next ndxB
    
    For ndxA = LBound(WordsA) To UBound(WordsA)
        If WordsA(ndxA) <> vbNullString Then strTemp = strTemp & WordsA(ndxA) & " "
    Next ndxA
    
    WORDDIF = Trim(strTemp)

End Function

OaklandJim · May 13, 2023

I was surprised that this "puzzle" took so much code. Code below does what you asked for.

I suspect that there will be glitches as you provided a limited number of examples for testing.

It is quite a bit of code. Probably way too much but hey, it works.

As usual, often better programmers, much better even, will probably find better or even much better ways to code this.

I am curious to know what this is for?

This is main function.

VBA Code:

Option Explicit

Function GetMatchType(psSearchString As String, psFindString As String) As String

'   ----------------------------------
'           Match Type Unknown
'   ----------------------------------
      
    GetMatchType = "?"

'   ----------------------------------
'              No Match
'   ----------------------------------
      
    If IsNoMatch(psSearchString, psFindString) _
     Then
        GetMatchType = "No Match"
        Exit Function
    End If

'   ----------------------------------
'            Perfect Match
'   ----------------------------------
  
    If IsPerfectMatch(psSearchString, psFindString) _
     Then
        GetMatchType = "Perfect Match"
        Exit Function
    End If
  
'   ----------------------------------
'         Perfect Plural Match
'   ----------------------------------
  
    If IsPerfectPlural(psSearchString, psFindString) _
     Then
        GetMatchType = "Perfect Plural"
        Exit Function
    End If

'   ----------------------------------
'              Mixed Match
'   ----------------------------------
 
    If IsMixedMatch(psSearchString, psFindString) _
     Then
        GetMatchType = "Mixed Match"
        Exit Function
    End If
  
'   ----------------------------------
'         Mixed Plural Match
'   ----------------------------------

    If IsMixedPlural(psSearchString, psFindString) _
     Then
        GetMatchType = "Mixed Plural"
        Exit Function
    End If

End Function

Primary Functions

VBA Code:

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: IsMixedMatch
' Purpose: Determine if there is a "Mixed Match"
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psValuesToSearch (String): String containing search words.
' Parameter psValuesToFind (String): String containing words to find within search string.
' Return Type: Boolean
' Author: Jim
' Date: 5/12/2023
' ----------------------------------------------------------------

Function IsMixedMatch(psValuesToSearch As String, psValuesToFind As String) As Boolean
  
'   There is a Mixed Plural match if 1. all words in find string are present in search
'   string, 2. find words are not in the same order as words in the search string
'   a partial string was not found, 4. there is not a mixed numeric condition, and
'   5. there is not a singular/plural mismatch.
  
    Dim bWordsMustBeAdjacent As Boolean

    IsMixedMatch = False
'
    bWordsMustBeAdjacent = True
  
    If IsAllWordsPresentPlural(psValuesToSearch, psValuesToFind) _
    And Not IsWordsInOrder(psValuesToSearch, psValuesToFind, bWordsMustBeAdjacent) _
    And Not IsPartialStringFound(psValuesToSearch, psValuesToFind) _
    And Not IsMixedNumeric(psValuesToSearch, psValuesToFind) _
    And Not IsSinglePluralMismatch(psValuesToSearch, psValuesToFind) _
     Then
        IsMixedMatch = True
    End If
  
End Function


' ----------------------------------------------------------------
' Procedure Name: IsMixedPlural
' Purpose: Determine if there is a "Mixed Plural" Match
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psValuesToSearch (String): String containing search words.
' Parameter psValuesToFind (String): String containing words to find within search string.
' Return Type: Boolean
' Author: Jim
' Date: 5/12/2023
' ----------------------------------------------------------------

Function IsMixedPlural( _
    psSearchString As String, _
    psFindString As String) As Boolean

'   There is a Mixed Plural match if 1. all words in find string are present in search
'   string, 2. there is a singular/plural mismatch, 3. find words are not in the same order
'   as words in the search string and 4. there is not a "No Match" condition.
  
    IsMixedPlural = False
  
    If IsAllWordsPresentSingular(psSearchString, psFindString) _
    And IsSinglePluralMismatch(psSearchString, psFindString) _
    And Not IsWordsInOrder(psSearchString, psFindString) _
    And Not IsNoMatch(psSearchString, psFindString) _
     Then
        IsMixedPlural = True
    End If

End Function

' ----------------------------------------------------------------
' Procedure Name: IsNoMatch
' Purpose: Determine if there is no match.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psSearchString (String): String containing search words to look within.
' Parameter psFindString (String): String containing words to find.
' Return Type: Boolean
' Author: Jim
' Date: 5/12/2023
' ----------------------------------------------------------------
Function IsNoMatch(psSearchString As String, psFindString As String) As Boolean

'   There is not a match if 1. all words are not present in sigular OR plural form,
'   2. "mixed" singular/plural numeric is found or 3. a partial string was found
  
    IsNoMatch = False
'
    If Not IsAllWordsPresentSingular(psSearchString, psFindString) Or _
       IsMixedNumeric(psSearchString, psFindString) Or _
       IsPartialStringFound(psSearchString, psFindString) _
     Then
        IsNoMatch = True
        Exit Function
    End If

End Function

' ----------------------------------------------------------------
' Procedure Name: IsPerfectMatch
' Purpose: Determine if the find string as-is is present in the search string.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psSearchString (String): String containing words to search within.
' Parameter psFindString (String): String containing the words to find within the search string.
' Author: Jim
' Date: 5/12/2023
' ----------------------------------------------------------------
Function IsPerfectMatch( _
    psSearchString As String, _
    psFindString As String) As Boolean
  
    Dim bIsFindStringInSearchString As Boolean
  
    Dim bIsPartialStringFound As Boolean
  
    bIsFindStringInSearchString = False
  
    If InStr(UCase(Trim(psSearchString)), UCase(Trim(psFindString))) _
     Then bIsFindStringInSearchString = True
  
    bIsPartialStringFound = IsPartialStringFound(psSearchString, psFindString)
  
    IsPerfectMatch = bIsFindStringInSearchString And Not bIsPartialStringFound

End Function

' ----------------------------------------------------------------
' Procedure Name: IsPerfectPlural
' Purpose: Determine there is a "Perfect Plural" match.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psSearchString (String): String containing words to search within.
' Parameter psFindString (String): String containing the words to find within the search string.
' Author: Jim
' Date: 5/12/2023
' ----------------------------------------------------------------

Function IsPerfectPlural( _
    psSearchString As String, _
    psFindString As String) As Boolean
  
    Dim bWordsMustBeAdjacent As Boolean

    IsPerfectPlural = False
      
    bWordsMustBeAdjacent = True
  
    If IsAllWordsPresentSingular(psSearchString, psFindString) _
    And IsSinglePluralMismatch(psSearchString, psFindString) _
    And IsWordsInOrder(psSearchString, psFindString, bWordsMustBeAdjacent) _
    And Not IsNoMatch(psSearchString, psFindString) _
     Then
        IsPerfectPlural = True
        Exit Function
    End If

End Function

Support Functions

VBA Code:

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: IsAllWordsPresentSingular
' Purpose: Determine if all words in a "find string" are within a "search string".
'          Ignores singular versus plural words. E.g. Find word "Dogs" is
'          present if compared to word in search string of "Dog"
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psSearchString (String): String to search in.
' Parameter psFindString (String): String containing words to search for.
' Return Type: Boolean
' Author: Jim
' Date: 5/9/2023
' ----------------------------------------------------------------

Function IsAllWordsPresentSingular(psSearchString As String, psFindString As String) As Boolean

'   Used to keep track of whether a find word was found in search words.
    Dim abWordIsPresent() As Boolean

'   Array that holds words to find.
    Dim asFindWords() As String
  
'   Count of find words are present in the string psFindString.
    Dim iFindWordsCount As Long
  
'   Used to loop through words in string psFindString.
    Dim iFindWord As Long
  
    psSearchString = Trim(UCase(psSearchString))
    psFindString = Trim(UCase(psFindString))
  
'   Initialize the function return value.
    IsAllWordsPresentSingular = True
  
'   Put all words to find in array asFindWords
    asFindWords = Split(psFindString, " ")
  
'   Make the split array one based instead of zero based.
    Call OneBasedArray(asFindWords)
  
'   Count of "find words" that are in the asFindWords array.
    iFindWordsCount = UBound(asFindWords)
  
'   Size the array holding true/false (found/not found) flags
    ReDim abWordIsPresent(iFindWordsCount)
  
'   Search in for all find words to determine if all find words are present.
    For iFindWord = 1 To iFindWordsCount
      
        Dim sSingularFindWord As String
      
        sSingularFindWord = asFindWords(iFindWord)
      
'       Remove S from the plural value.
        If Right(sSingularFindWord, 1) = "S" _
         Then sSingularFindWord = Left(sSingularFindWord, Len(sSingularFindWord) - 1)

        If InStr(1, psSearchString, sSingularFindWord) _
         Then
            abWordIsPresent(iFindWord) = True
        Else
            abWordIsPresent(iFindWord) = False
        End If

    Next iFindWord

'   Determine if all find words are present in search words.
    For iFindWord = 1 To iFindWordsCount

        If Not abWordIsPresent(iFindWord) _
         Then
            IsAllWordsPresentSingular = False
            Exit For
        End If

    Next iFindWord
  
End Function



' ----------------------------------------------------------------
' Procedure Name: IsAllWordsPresentPlural
' Purpose: Determine if all words in a "find string" are within a "search string".
'          Does not ignore singular versus plural words. E.g. Find word "Dogs" is
'          not present if compared to word in search string of "Dog"
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psSearchString (String): String to search in.
' Parameter psFindString (String): String containing words to search for.
' Return Type: Boolean
' Author: Jim
' Date: 5/9/2023
' ----------------------------------------------------------------

Function IsAllWordsPresentPlural(psSearchString As String, psFindString As String) As Boolean

'   Used to keep track of whether a find word was found in search words.
    Dim abWordIsPresent() As Boolean

'   Array that holds words to find.
    Dim asFindWords() As String
  
'   Count of find words are present in the string psFindString.
    Dim iFindWordsCount As Long
  
'   Used to loop through words in string psFindString.
    Dim iFindWord As Long
  
'   Initialize the function return value.
    IsAllWordsPresentPlural = True
  
'   Make search and find strings upper case.
    psSearchString = Trim(UCase(psSearchString))
    psFindString = Trim(UCase(psFindString))
  
'   Put all words to find in array asFindWords
    asFindWords = Split(psFindString, " ")
  
'   Make the split array one based instead of zero based.
    Call OneBasedArray(asFindWords)
  
'   Count of "find words" that are in the asFindWords array.
    iFindWordsCount = UBound(asFindWords)
  
'   Size the array holding true/false (found/not found) flags
    ReDim abWordIsPresent(iFindWordsCount)
  
'   Search in for all find words to determine if all find words are present.
    For iFindWord = 1 To iFindWordsCount

        If InStr(psSearchString, asFindWords(iFindWord)) _
         Then
            abWordIsPresent(iFindWord) = True
        Else
            abWordIsPresent(iFindWord) = False
        End If

    Next iFindWord

'   Determine if all find words are present in search words.
    For iFindWord = 1 To iFindWordsCount

        If Not abWordIsPresent(iFindWord) _
         Then
            IsAllWordsPresentPlural = False
            Exit For
        End If

    Next iFindWord

End Function

' ----------------------------------------------------------------
' Procedure Name: IsAWordEndingInS
' Purpose: Determine if string parameter psWord is a word ending in S that is not plural.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psWord (String): String whose content is checked against the list of words ending in S.
' Return Type: Boolean
' Author: Jim
' Date: 5/13/2023
' ----------------------------------------------------------------

'Add any "problematic" word that ends in S but and that is not the plural
'form of the word.

'For a complete list of many words ending in S.
'see https://byjus.com/english/words-that-end-with-s/

Function IsAWordEndingInS(psWord As String) As Boolean

    IsAWordEndingInS = False

    Select Case UCase(psWord)

    Case "NEWS"
        IsAWordEndingInS = True

    Case "MATHEMATICS"
        IsAWordEndingInS = True

    Case "CIVICS"
        IsAWordEndingInS = True

    Case "PHYSICS"
         IsAWordEndingInS = True

    Case "MOLASSES"
         IsAWordEndingInS = True

    Case "BILLIARDS"
         IsAWordEndingInS = True
       
    Case "BASS"
        IsAWordEndingInS = True

    Case "MASS"
         IsAWordEndingInS = True
       
    Case "ASBESTOS"
         IsAWordEndingInS = True

    End Select

End Function

' ----------------------------------------------------------------
' Procedure Name: IsMixedNumeric
' Purpose: Determine if there is a "mixed" numeric values -- "based on plural"
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psValuesToSearch (String): String containing values to search.
' Parameter psValuesToFind (String): String containing values to find.
' Author: Jim
' Date: 5/10/2023
' ----------------------------------------------------------------
Function IsMixedNumeric(psValuesToSearch As String, psValuesToFind As String)

    Dim iWordIndex As Long
  
    Dim iWordCount As Long
  
    Dim sWord As String

    Dim sSingularOfNumber As String
    Dim sPluralOfNumber As String
  
    Dim asValuesToSearch() As String
    Dim asValuesToFind() As String
  
    psValuesToSearch = Trim(UCase(psValuesToSearch))
    psValuesToFind = Trim(UCase(psValuesToFind))
  
    asValuesToSearch = Split(psValuesToSearch, " ")
    asValuesToFind = Split(psValuesToFind, " ")
  
    Call OneBasedArray(asValuesToSearch)
    Call OneBasedArray(asValuesToFind)
  
    iWordCount = UBound(asValuesToFind)
  
    IsMixedNumeric = False
  
    Dim bNumberIsPlural As Boolean
  
    For iWordIndex = 1 To iWordCount
  
        If IsNumeric(Left(asValuesToFind(iWordIndex), 1)) _
         Then

            bNumberIsPlural = Not IsNumeric(Right(asValuesToFind(iWordIndex), 1))

'           Look for plural words -- they end in s
            If bNumberIsPlural _
             Then
              
                sSingularOfNumber = Left(asValuesToFind(iWordIndex), Len(asValuesToFind(iWordIndex)) - 1)
'
                If InStr(1, psValuesToSearch, sSingularOfNumber) _
                 Then
                    IsMixedNumeric = True
                End If
          
            Else
          
                sPluralOfNumber = UCase(asValuesToFind(iWordIndex)) & "S"
'
                If InStr(1, UCase(psValuesToSearch), sPluralOfNumber) _
                 Then
                    IsMixedNumeric = True
                End If
          
            End If
'
        End If
'
    Next iWordIndex

End Function

' ----------------------------------------------------------------
' Procedure Name: IsPartialStringFound
' Purpose: Determine if there is a "partial" string in the find words. For example
'          If search words include Tree and a find word is Tr.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psStringToSearch (String): String to search in.
' Parameter psStringToFind (String): String containing words to find.
' Return Type: Boolean
' Author: Jim
' Date: 5/11/2023
' ----------------------------------------------------------------
Function IsPartialStringFound(psStringToSearch As String, psStringToFind As String) As Boolean

'   ------------------------
'        Declarations
'   ------------------------

'   String array holds words to find.
    Dim asStringsToFind() As String
  
'   Used to loop through the "find words."
    Dim iWord As Long
    Dim iWordsFound As Long
  
'   Char number in the search string where the find word was located.
    Dim iFoundChar As Long

'   Length of String variables for 1. the "correspoding" word found in search string
'   and 2. the word to find.
    Dim iLenSearchWord As Long
    Dim iLenFindWord As Long
  
'   Used in Do Loop looking for the respective search word (from the search string)
    Dim iNextChar As Long
  
'   String variables for 1. the "corresponding" word in the search string
'   and 2. the word to find.
    Dim sWordInSearchString As String
    Dim sWordToFind As String
  
'   ------------------------
'       Initializations
'   ------------------------
    psStringToSearch = Trim(UCase(psStringToSearch))
  
    psStringToFind = Trim(UCase(psStringToFind))
  
    asStringsToFind = Split(psStringToFind, " ")
  
    Call OneBasedArray(asStringsToFind)
  
    iWordsFound = UBound(asStringsToFind)

    IsPartialStringFound = False
  
    For iWord = 1 To iWordsFound
  
        sWordToFind = Trim(UCase(asStringsToFind(iWord)))
        iLenFindWord = Len(sWordToFind)

        iFoundChar = InStr(1, psStringToSearch, sWordToFind)
      
        If iFoundChar <> 0 _
         Then

            iNextChar = 0

            sWordInSearchString = ""

'           Locate the "corresponding" word in the search string.
            Do
                sWordInSearchString = sWordInSearchString & UCase(Mid(psStringToSearch, iFoundChar + iNextChar, 1))

                iNextChar = iNextChar + 1

            Loop Until Mid(psStringToSearch, iNextChar, 1) = " "
          
'           Get the current "search word" from the search string and its length.
            sWordInSearchString = Trim(sWordInSearchString)
            iLenSearchWord = Len(sWordInSearchString)
          
            If iLenFindWord >= iLenSearchWord _
             Then
                GoTo NextIteration
           
             Else 'iLenFindWord < iLenSearchWord
              
                If Right(sWordInSearchString, 1) <> "S" _
                 Then
                    IsPartialStringFound = True
                    Exit Function
                End If
          
            End If
'
        End If

NextIteration:

    Next iWord

End Function



' ----------------------------------------------------------------
' Procedure Name: IsSinglePluralMismatch
' Purpose: Determine if there is a mixed singular/plural mismatch.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psSearchString (String): String containing words to search within.
' Parameter psFindString (String): String containng find words.
' Return Type: Boolean
' Author: Jim
' Date: 5/12/2023
' ----------------------------------------------------------------
Function IsSinglePluralMismatch(psSearchString As String, psFindString As String) As Boolean

'   Arrays holding words in 1. the search string 2. the find string.
    Dim asSearchWords() As String
    Dim asFindWords() As String
  
'   Word from 1. the search words list and 2. the find words list.
    Dim sSearchWord As String
    Dim sFindWord As String
  
'   Word from 1. the search words list and 2. the find words list.
    Dim sFindWordSingular As String
    Dim sFindWordPlural As String
  
'   Count of search words found and of find words found.
    Dim iSearchWordsCount As Long
    Dim iFindWordsCount As Long
  
'   Used to loop through search and find words to process
    Dim iSearchWordIndex As Long
    Dim iFindWordIndex As Long
  
'   ------------------------------
'           Initializations
'   ------------------------------

    IsSinglePluralMismatch = False
  
'   Make all text Ucase and Trimmed
    psSearchString = Trim(UCase(psSearchString))
    psFindString = Trim(UCase(psFindString))
  
'   Split "search in" string and "find string" into arrays.
    asSearchWords = Split(psSearchString, " ")
    asFindWords = Split(psFindString, " ")
  
'   Convert split search words array and find words array to one based
'   indexing from zero based
    Call OneBasedArray(asSearchWords)
    Call OneBasedArray(asFindWords)
  
    iSearchWordsCount = UBound(asSearchWords)
    iFindWordsCount = UBound(asFindWords)
  
    For iFindWordIndex = 1 To iFindWordsCount
  
        sFindWord = Trim(asFindWords(iFindWordIndex))
      
'       Search for 1. plural version of the find word is in search words as singular
'                  2. singular version of the find word is in search words as plural
      
'       ----------------------------------------
'           Do Not Process Words Ending In S
'           e.g. News, Mess, Asbestos, etc.
'       ----------------------------------------
      
        If IsAWordEndingInS(sFindWord) _
         Then
'           Do Nothing
      
'       Is find word singular -- not ends in S
        ElseIf Right(sFindWord, 1) <> "S" _
         Then

'       ----------------------------------------------------------------
'           Is Singular Find Word Present as Plural in Search String
'       ----------------------------------------------------------------

'           Loop all search words to determine if there is a plural version
'           of the find word present in the search words as a plural version.
            For iSearchWordIndex = 1 To iSearchWordsCount

'               Get next search word from search words array (asSearchWords)
                sSearchWord = Trim(asSearchWords(iSearchWordIndex))

'               Is search word plural?
                If Right(sSearchWord, 1) = "S" _
                 Then

'                   Singularize the plural version of he search word.
                    sSearchWord = Left(sSearchWord, Len(sSearchWord) - 1)

'                   Look for singular version of find word is present as a plural.
'                   version of the search word. If so return True and exit function.
                    If sSearchWord = sFindWord _
                     Then
                        IsSinglePluralMismatch = True
                        Exit Function
                    End If

                End If

            Next iSearchWordIndex

        Else
          
'       -----------------------------------------------------------------
'           Is Plural Find Word Present as Singular in Search String
'       -----------------------------------------------------------------
      
'           Loop all search words to determine if there is a singular version
'           of the find word present in the search words as a singular version.
            For iSearchWordIndex = 1 To iSearchWordsCount

'               Get next search word from search words array (asSearchWords)
                sSearchWord = Trim(asSearchWords(iSearchWordIndex))
          
'               Is search word singular?
                If Right(sSearchWord, 1) <> "S" _
                 Then
               
'                   Pluralize the singular version of he search word.
                    sSearchWord = sSearchWord & "S"
                  
'                   Look for plural version of find word is present as a singular.
'                   version of the search word. If so return True and exit function.
                    If sSearchWord = sFindWord _
                     Then
                        IsSinglePluralMismatch = True
                        Exit Function
                    End If
                  
                 End If
      
            Next iSearchWordIndex
      
        End If

    Next iFindWordIndex

End Function

' ----------------------------------------------------------------
' Procedure Name: IsSinglePluralMismatch
' Purpose: Determine if there is a mixed singular/plural mismatch.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psSearchString (String): String containing words to search within.
' Parameter psFindString (String): String containng find words.
' Return Type: Boolean
' Author: Jim
' Date: 5/12/2023
' ----------------------------------------------------------------
Function IsSinglePluralMismatch(psSearchString As String, psFindString As String) As Boolean

'   Arrays holding words in 1. the search string 2. the find string.
    Dim asSearchWords() As String
    Dim asFindWords() As String
  
'   Word from 1. the search words list and 2. the find words list.
    Dim sSearchWord As String
    Dim sFindWord As String
  
'   Word from 1. the search words list and 2. the find words list.
    Dim sFindWordSingular As String
    Dim sFindWordPlural As String
  
'   Count of search words found and of find words found.
    Dim iSearchWordsCount As Long
    Dim iFindWordsCount As Long
  
'   Used to loop through search and find words to process
    Dim iSearchWordIndex As Long
    Dim iFindWordIndex As Long
  
'   ------------------------------
'           Initializations
'   ------------------------------

    IsSinglePluralMismatch = False
  
'   Make all text Ucase and Trimmed
    psSearchString = Trim(UCase(psSearchString))
    psFindString = Trim(UCase(psFindString))
  
'   Split "search in" string and "find string" into arrays.
    asSearchWords = Split(psSearchString, " ")
    asFindWords = Split(psFindString, " ")
  
'   Convert split search words array and find words array to one based
'   indexing from zero based
    Call OneBasedArray(asSearchWords)
    Call OneBasedArray(asFindWords)
  
    iSearchWordsCount = UBound(asSearchWords)
    iFindWordsCount = UBound(asFindWords)
  
    For iFindWordIndex = 1 To iFindWordsCount
  
        sFindWord = Trim(asFindWords(iFindWordIndex))
      
'       Search for 1. plural version of the find word is in search words as singular
'                  2. singular version of the find word is in search words as plural
      
'       ----------------------------------------
'           Do Not Process Words Ending In S
'           e.g. News, Mess, Asbestos, etc.
'       ----------------------------------------
      
        If IsAWordEndingInS(sFindWord) _
         Then
'           Do Nothing
      
'       Is find word singular -- not ends in S
        ElseIf Right(sFindWord, 1) <> "S" _
         Then

'       ----------------------------------------------------------------
'           Is Singular Find Word Present as Plural in Search String
'       ----------------------------------------------------------------

'           Loop all search words to determine if there is a plural version
'           of the find word present in the search words as a plural version.
            For iSearchWordIndex = 1 To iSearchWordsCount

'               Get next search word from search words array (asSearchWords)
                sSearchWord = Trim(asSearchWords(iSearchWordIndex))

'               Is search word plural?
                If Right(sSearchWord, 1) = "S" _
                 Then

'                   Singularize the plural version of he search word.
                    sSearchWord = Left(sSearchWord, Len(sSearchWord) - 1)

'                   Look for singular version of find word is present as a plural.
'                   version of the search word. If so return True and exit function.
                    If sSearchWord = sFindWord _
                     Then
                        IsSinglePluralMismatch = True
                        Exit Function
                    End If

                End If

            Next iSearchWordIndex

        Else
          
'       -----------------------------------------------------------------
'           Is Plural Find Word Present as Singular in Search String
'       -----------------------------------------------------------------
      
'           Loop all search words to determine if there is a singular version
'           of the find word present in the search words as a singular version.
            For iSearchWordIndex = 1 To iSearchWordsCount

'               Get next search word from search words array (asSearchWords)
                sSearchWord = Trim(asSearchWords(iSearchWordIndex))
          
'               Is search word singular?
                If Right(sSearchWord, 1) <> "S" _
                 Then
               
'                   Pluralize the singular version of he search word.
                    sSearchWord = sSearchWord & "S"
                  
'                   Look for plural version of find word is present as a singular.
'                   version of the search word. If so return True and exit function.
                    If sSearchWord = sFindWord _
                     Then
                        IsSinglePluralMismatch = True
                        Exit Function
                    End If
                  
                 End If
      
            Next iSearchWordIndex
      
        End If

    Next iFindWordIndex

End Function


' ----------------------------------------------------------------
' Procedure Name: IsWordsInOrder
' Purpose: Determine if words in find string are in sequential order as search string.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter psSearchString (String): String of words to search in.
' Parameter psFindString (String): String of words to search for.
' Optioanl Parameter pbMustBeAdjacent: Boolean indicating whether find words must
'                                      be adjacent/next to each other in the search string.
' Author: Jim
' Date: 5/9/2023
' ----------------------------------------------------------------

Function IsWordsInOrder( _
  psSearchString As String, _
  psFindString As String, _
  Optional pbMustBeAdjacent As Boolean = True) _
As Boolean

'   Arrays holding words in 1. the search string 2. the find string.
    Dim asSearchWords() As String
    Dim asFindWords() As String
  
'   Word from 1. the search words list and 2. the find words list.
    Dim sSearchWord As String
    Dim sFindWord As String

'   "Singular" version of the two above values (no ending S).
    Dim sSearchWordSingular As String
    Dim sFindWordSingular As String
  
'   Count of search words found and of find words found.
    Dim iSearchWordsCount As Long
    Dim iFindWordsCount As Long
  
'   Used to loop through search and find words to process
    Dim iSearchWordIndex As Long
    Dim iFindWordIndex As Long
  
'   Flag indicating that all words in find string are present in search string.
    Dim bAllWordsArePresent As Boolean
  
'   Array that holds data about find words 1. the word and 2. the sequence order
'   of find words in search words (string).
    Dim avFoundWords() As Variant
  
'   Used to loop avFoundWords array, to keep track of what order find
'   words appear in the search words (string.
    Dim iPreviousPosition As Long
    Dim iCurrentPosition As Long
  
'   ------------------------------
'           Initializations
'   ------------------------------
  
'   Make all text Ucase and Trimmed
    psSearchString = Trim(UCase(psSearchString))
    psFindString = Trim(UCase(psFindString))
  
'   Split "search in" string and "find string" into arrays.
    asSearchWords = Split(psSearchString, " ")
    asFindWords = Split(psFindString, " ")
  
'   Convert split search words array and find words array to one based
'   indexing from zero based
    Call OneBasedArray(asSearchWords)
    Call OneBasedArray(asFindWords)
  
'   Count of search words found and of find words found.
    iSearchWordsCount = UBound(asSearchWords)
    iFindWordsCount = UBound(asFindWords)
  
'   Dimensioning of the array holding words found and thier order.
    ReDim avFoundWords(1 To 2, 1)
  
'   Initialize the function return value.
    IsWordsInOrder = True

'   ---------------------------------------------------------
'          Handle All "Find Words" not In "Search Words"
'   ---------------------------------------------------------

'   Determine if all words in string to find are in the search string.
'   Ignore singular/plural conflict. If searching for "Dogs" and the word
'   "Dog" is in the search string (no S) then the word is present in the
'   search string.

    bAllWordsArePresent = IsAllWordsPresentSingular(psSearchString, psFindString)

    If Not bAllWordsArePresent _
     Then
        IsWordsInOrder = False
        Exit Function
    End If

'   ------------------------------------------------------
'           Handle Partial Word is in Find String
'   ------------------------------------------------------

    If IsPartialStringFound(psSearchString, psFindString) _
     Then
        IsWordsInOrder = False
        Exit Function
    End If

'   -----------------------------------------------
'       Get Find Words' Order in Search Words
'   -----------------------------------------------

'   If All "find words" are present then Loop all "find words" to
'   determine the order in which they appear in the "search string."

    For iFindWordIndex = 1 To iFindWordsCount
'
        sFindWord = asFindWords(iFindWordIndex)

        If Right(sFindWord, 1) = "S" _
         Then
            sFindWordSingular = Left(sFindWord, Len(sFindWord) - 1)
        Else
            sFindWordSingular = sFindWord
        End If

'           Loop all "search words" to determine if the current "find string"
'           is included in the search string. Get sequential order of appearance
'           (of find words in search words).
        For iSearchWordIndex = 1 To iSearchWordsCount

            sSearchWord = asSearchWords(iSearchWordIndex)

            If Right(sSearchWord, 1) = "S" _
             Then
                sSearchWordSingular = Left(sSearchWord, Len(sSearchWord) - 1)
            Else
                sSearchWordSingular = sSearchWord
            End If

            If sFindWord = sSearchWord Or sFindWordSingular = sSearchWordSingular _
             Then

'               Fill array with info about the find word located in the search
'               words (string). Index 1 is the word, index 2 is the indicates the
'               "ordinal position" in the search words (string) i.e., where the
'               find word is located among the search words.
                ReDim Preserve avFoundWords(1 To 2, iFindWordIndex)
                avFoundWords(1, iFindWordIndex) = sFindWordSingular
                avFoundWords(2, iFindWordIndex) = iSearchWordIndex

            End If

        Next iSearchWordIndex
'
    Next iFindWordIndex
  
'   --------------------------------------
'        Handle Words Not in Order
'   --------------------------------------

'   If in the "search string" the "find words" are not in the same order
'   then return false value as items are not sequential.

    For iFindWordIndex = 1 To UBound(avFoundWords)

        If iFindWordIndex = 1 _
         Then
            iPreviousPosition = avFoundWords(2, 1)
        Else
            If avFoundWords(2, iFindWordIndex) < iPreviousPosition _
             Then
                IsWordsInOrder = False
                Exit Function
            End If
          
            iPreviousPosition = avFoundWords(2, iFindWordIndex)
      
        End If
  
    Next iFindWordIndex
  
'   -------------------------------------------------------
'       Handle Find Words Not Adjacent in Search String
'   -------------------------------------------------------

'   pbMustBeAdjacent is a Flag indicating whether words must be adjacent (next to)
'   to each other in the search string. Example if search string contains
'   Dog, Cat, Frog, Goat then 1. Cat and Dog are adjacent, 2. Cat and Goat are not.

'   If in the search string there is a word between the find
'   words then return false value as items are not adjacent/next
'   to each other.
  
    If pbMustBeAdjacent _
     Then
  
        For iFindWordIndex = 1 To UBound(avFoundWords)
            If iFindWordIndex = 1 _
             Then
                iPreviousPosition = avFoundWords(2, 1)
          
            Else
                If avFoundWords(2, iFindWordIndex) - 1 <> iPreviousPosition _
                 Then
                    IsWordsInOrder = False
                    Exit Function
                End If
              
                iPreviousPosition = avFoundWords(2, iFindWordIndex)
  
            End If
          
        Next iFindWordIndex
  
    End If
  
End Function

' ----------------------------------------------------------------
' Procedure Name: OneBasedArray
' Purpose: Convert string array from zero based indexing to one based.
' Procedure Kind: Function
' Procedure Access: Public
' Parameter pasValues (String): Array to convert.
' Return Type: String)
' Author: Jim
' Date: 5/9/2023
' ----------------------------------------------------------------
Function OneBasedArray(ByRef pasValues() As String)
  
    Dim iUbound As Long
  
    Dim asTemp() As String
  
    Dim iValue As Long
  
    iUbound = UBound(pasValues)

    ReDim asTemp(1 To iUbound + 1)
  
    For iValue = 0 To iUbound
  
       asTemp(iValue + 1) = pasValues(iValue)
  
    Next iValue
  
    pasValues = asTemp
  
End Function

morevijay1982 · Oct 7, 2023

rondeondo said:

Hi Henient,

this worsheet function will compare two cells and give any words from the second that are not present in the first. I expect you could change up the logic a little to suit your purposes.

VBA Code:

Function WORDDIF(strA As String, strB As String) As String

    Dim WordsA As Variant, WordsB As Variant
    Dim ndxA As Long, ndxB As Long, strTemp As String
      
    WordsA = Split(strA, " ")
    WordsB = Split(strB, " ")
  
    For ndxB = LBound(WordsB) To UBound(WordsB)
        For ndxA = LBound(WordsA) To UBound(WordsA)
            If StrComp(WordsA(ndxA), WordsB(ndxB), vbTextCompare) = 0 Then
                WordsA(ndxA) = vbNullString
                Exit For
            End If
        Next ndxA
    Next ndxB
  
    For ndxA = LBound(WordsA) To UBound(WordsA)
        If WordsA(ndxA) <> vbNullString Then strTemp = strTemp & WordsA(ndxA) & " "
    Next ndxA
  
    WORDDIF = Trim(strTemp)

End Function

[
[/QUOTE]

rondeondo said:

Hi Henient,

this worsheet function will compare two cells and give any words from the second that are not present in the first. I expect you could change up the logic a little to suit your purposes.

VBA Code:

Function WORDDIF(strA As String, strB As String) As String

    Dim WordsA As Variant, WordsB As Variant
    Dim ndxA As Long, ndxB As Long, strTemp As String
       
    WordsA = Split(strA, " ")
    WordsB = Split(strB, " ")
   
    For ndxB = LBound(WordsB) To UBound(WordsB)
        For ndxA = LBound(WordsA) To UBound(WordsA)
            If StrComp(WordsA(ndxA), WordsB(ndxB), vbTextCompare) = 0 Then
                WordsA(ndxA) = vbNullString
                Exit For
            End If
        Next ndxA
    Next ndxB
   
    For ndxA = LBound(WordsA) To UBound(WordsA)
        If WordsA(ndxA) <> vbNullString Then strTemp = strTemp & WordsA(ndxA) & " "
    Next ndxA
   
    WORDDIF = Trim(strTemp)

End Function

sir great innovation

how to add 3rd cell comparison

kindly enlighten

Use VBA to check whether cell contains words from another cell

Helient

New Member

Attachments

Excel Facts

rondeondo

Active Member

OaklandJim

Well-known Member

morevijay1982

New Member

Similar threads

Forum statistics

Share this page

Use VBA to check whether cell contains words from another cell

Helient

New Member

Attachments

Excel Facts

rondeondo

Active Member

OaklandJim

Well-known Member

morevijay1982

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock