VBA Merging two strings excluding overlap part-CodePudding

Is it possible to merge two strings but when end of s1 is the same as beginning of s2 do not repeat that part of the string? For example:

s1 = "The quick "          s2 = "brown fox"       -> "The quick brown fox"
s1 = "The quick brown fox" s2 = "quick brown fox" -> "The quick brown fox"
s1 = "The quick brown "    s2 = "quick brown fox" -> "The quick brown fox"
s1 = "The quick brown fox" s2 = ""                -> "The quick brown fox"
s1 = ""                    s2 = "fox"             -> "fox"

CodePudding user response：

I don't think you can do this with a simple formula, but you can write a rather simple function. You could use it in your code or as a UDF in an Excel sheet.

The code loops over the length of the second string and compares if the left part of the second string is equal to to right part of the first string.

Function mergeString(s1 As String, s2 As String)
    Dim i As Long
    For i = Len(s2) To 1 Step -1
        If Left(s2, i) = Right(s1, i) Then
            mergeString = s1 & Mid(s2, i   1)
            Exit Function
        End If
    Next i
    ' Nothing matches
    mergeString = s1 & s2
End Function

CodePudding user response：

Just for fun, I'll add a formula:

Formula in C1:

=@LET(X,LEN(A1),Y,SEQUENCE(X),Z,MID(A1,Y,X),SORT(IF(IFERROR(SEARCH(Z&"*",B1),0)=1,LEFT(A1,X-LEN(Z)),A1)))&B1

CodePudding user response：

Solution

Code

Sub Exec_StringCheck()
Dim s1 As String, s2 As String
    s1 = "The quick ": s2 = "brown fox"
    Debug.Print Return_TxtMerged(s1, s2, " ")
    s1 = "The quick brown fox": s2 = "quick brown fox"
    Debug.Print Return_TxtMerged(s1, s2, " ")
    s1 = "The quick brown ": s2 = "quick brown fox"
    Debug.Print Return_TxtMerged(s1, s2, " ")
    s1 = "The quick brown fox": s2 = ""
    Debug.Print Return_TxtMerged(s1, s2, " ")
    s1 = "": s2 = "fox"
    Debug.Print Return_TxtMerged(s1, s2, " ")
End Sub
Function Return_TxtMerged(TxtOneToMerge As String, TxtTwoToMerge As String, TxtDelimiter As String)
Dim CounterArrTxtTwoToMerge As Long
Dim ArrVarTxtTwoToMerge As Variant: ArrVarTxtTwoToMerge = Split(TxtTwoToMerge, TxtDelimiter)
Dim TxtDummy As String
    For CounterArrTxtTwoToMerge = 0 To UBound(ArrVarTxtTwoToMerge)
    If InStr(TxtOneToMerge, CStr(ArrVarTxtTwoToMerge(CounterArrTxtTwoToMerge))) = 0 Then ' 1. InStr(TxtOneToMerge, CStr(ArrVarTxtTwoToMerge(CounterArrTxtTwoToMerge))) = 0
    TxtDummy = IIf(TxtDummy = "", CStr(ArrVarTxtTwoToMerge(CounterArrTxtTwoToMerge)), TxtDummy & TxtDelimiter & CStr(ArrVarTxtTwoToMerge(CounterArrTxtTwoToMerge)))
    End If ' 1. InStr(TxtOneToMerge, CStr(ArrVarTxtTwoToMerge(CounterArrTxtTwoToMerge))) = 0
    Next CounterArrTxtTwoToMerge
    Return_TxtMerged = TxtOneToMerge & TxtDummy
End Function

CodePudding user response：

If you are using O365, then you may apply any one of the approaches as well,

FORMULA APPROACH ONE: In Cell C1

=TEXTJOIN(" ",,UNIQUE(FILTERXML("<a><b>"&SUBSTITUTE(TEXTJOIN(" ",,TRIM(A1:B1))," ","</b><b>")&"</b></a>","//b")))

FORMULA APPROACH TWO: In Cell D1

=TEXTJOIN(" ",,UNIQUE(TRIM(MID(SUBSTITUTE(A1&" "&B1," ",REPT(" ",100)),COLUMN(A1:Z1)*99-98,100)),1))