Remove duplicate words within a string in Access

Cherie Woodward
Cherie Woodward used Ask the Experts™
on
I need to remove duplicate words from within a string.  I found code to do it and it works but a little too well.  The code below will remove anything that is repeated again even if it is just part of a word.

Ex:  construction company t shirts construction shirt construction co t shirt
Becomes:  construction company shirts
What I want: construction company t shirts shirt co


How can I make this code remove the duplicates while not removing anything that is part of another word?

Public Function EliminateDupesInString(strText As String, Optional strDelim As String = " ") As String
    ' remove duplicate strings from within a longer string
    ' "AIRTEX 1241 AIRTEX AW3409 CHRYSLER 7700598025 CHRYSLER JR775056 DELPHI DD1265 DELPHI DD1666 DELPHI WP1039 DELPHI WP1747 DELPHI WP2235 RENAULT 7700598025"
    '  becomes "AIRTEX 1241 AW3409 CHRYSLER 7700598025 JR775056 DELPHI DD1265 DD1666 WP1039 WP1747 WP2235 RENAULT"
    Dim varArray As Variant
    Dim intI As Integer
    Dim strOut As String
    strText = " " & strText & " "
    varArray = Split(strText, strDelim)
    For intI = 0 To UBound(varArray) - 1
        If InStr(strOut, varArray(intI)) = 0 Then
            strOut = strOut & varArray(intI) & " "
        End If
        'Debug.Print varArray(intI)
    Next
    EliminateDupesInString = Trim(strOut)
End Function
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Software Team Lead
Commented:
try this quick fix:

Public Function EliminateDupesInString(strText As String, Optional strDelim As String = " ") As String
    ' remove duplicate strings from within a longer string
    ' "AIRTEX 1241 AIRTEX AW3409 CHRYSLER 7700598025 CHRYSLER JR775056 DELPHI DD1265 DELPHI DD1666 DELPHI WP1039 DELPHI WP1747 DELPHI WP2235 RENAULT 7700598025"
    '  becomes "AIRTEX 1241 AW3409 CHRYSLER 7700598025 JR775056 DELPHI DD1265 DD1666 WP1039 WP1747 WP2235 RENAULT"
    Dim varArray As Variant
    Dim intI As Integer
    Dim strOut As String
    Dim tmpArr() As String, isFound As Boolean
    
    strText = " " & strText & " "
    varArray = Split(strText, strDelim)
    For intI = 0 To UBound(varArray) - 1
        isFound = False
        If IsArrayEmpty(tmpArr) = False Then
            For i = 0 To UBound(tmpArr)
                If varArray(intI) = tmpArr(i) Then
                    isFound = True
                    Exit For
                End If
            Next
        End If
        If isFound = False Then
            If IsArrayEmpty(tmpArr) = False Then
                ReDim Preserve tmpArr(UBound(tmpArr) + 1)
            Else
                ReDim Preserve tmpArr(0)
            End If
            tmpArr(UBound(tmpArr)) = varArray(intI)
            strOut = strOut & varArray(intI) & " "
        End If
        'Debug.Print varArray(intI)
    Next
    EliminateDupesInString = Trim(strOut)
End Function

Function IsArrayEmpty(anArray As Variant) As Boolean
    On Error GoTo EH
    If (UBound(anArray) >= 0) Then Exit Function
EH:
    IsArrayEmpty = True
End Function

Open in new window

Cherie WoodwardPresident

Author

Commented:
Thank you! That fixed it.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial