CODEWITHSUNDEEP
vbafunctionexcelduplicates
Brennan Casler
Brennan Casler

Reputation: 11

Excel VBA Custom Function Remove Words Appearing in One String From Another String

I am trying to remove words appearing in one string from a different string using a custom function. For instance:

A1:

the was why blue hat


A2:

the stranger wanted to know why his blue hat was turning orange

The ideal outcome in this example would be:
A3:

stranger wanted to know his turning orange

I need to have the cells in reference open to change so that they can be used in different situations. The function will be used in a cell as:

=WORDREMOVE("cell with words needing remove", "cell with list of words being removed")

I have a list of 20,000 rows and have managed to find a custom function that can remove duplicate words (below) and thought there may be a way to manipulate it to accomplish this task.

Function REMOVEDUPEWORDS(txt As String, Optional delim As String = " ") As String
Dim x
'Updateby20140924
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each x In Split(txt, delim)
        If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
    Next
    If .Count > 0 Then REMOVEDUPEWORDS = Join(.keys, delim)
End With
End Function

Upvotes: 0

Views: 528

Answers (3)

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60224

You can also do this using Regular Expressions in VBA. The version below is case insensitive and assumes all words are separated only by space. If there is other punctuation, more examples would aid in crafting an appropriate solution:

Option Explicit
Function WordRemove(Str As String, RemoveWords As String) As String
    Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
    .ignorecase = True
    .Global = True
    .Pattern = "(?:" & Join(Split(WorksheetFunction.Trim(RemoveWords)), "|") & ")\s*"
    WordRemove = .Replace(Str, "")
End With

End Function

Upvotes: 1

Bond
Bond

Reputation: 16311

If you can guarantee that your words in both strings will be separated by spaces (no comma, ellipses, etc), you could just Split() both strings then Filter() out the words:

Function WORDREMOVE(ByVal strText As String, strRemove As String) As String

    Dim a, w
    a = Split(strText)             ' Start with all words in an array

    For Each w In Split(strRemove)
        a = Filter(a, w, False, vbTextCompare)  ' Remove every word found
    Next

    WORDREMOVE = Join(a, " ")      ' Recreate the string

End Function

Upvotes: 3

azera
azera

Reputation: 128

My example is certainly not the best code, but it should work

Function WORDREMOVE(FirstCell As String, SecondCell As String)

Dim FirstArgument As Variant, SecondArgument As Variant
Dim FirstArgumentCounter As Integer, SecondArgumentCounter As Integer
Dim Checker As Boolean

WORDREMOVE = ""

FirstArgument = Split(FirstCell, " ")
SecondArgument = Split(SecondCell, " ")

For SecondArgumentCounter = 0 To UBound(SecondArgument)
    Checker = False

    For FirstArgumentCounter = 0 To UBound(FirstArgument)

        If SecondArgument(SecondArgumentCounter) = FirstArgument(FirstArgumentCounter) Then
            Checker = True
        End If

    Next FirstArgumentCounter

    If Checker = False Then WORDREMOVE = WORDREMOVE & SecondArgument(SecondArgumentCounter) & " "

Next SecondArgumentCounter

    WORDREMOVE = Left(WORDREMOVE, Len(WORDREMOVE) - 1) 
End Function

Upvotes: 0

Related Questions