Return the difference between two “strings” of part numbers

I followed Grumm's suggestion and tried the code he referenced. It was half right. It isn't symmetrical so it has to be used twice and then the results merged, but in the end this Rube Goldberg in the attached database seems to work ok.

The output of the function fnDiff is delimited by commas without any spaces after the comma, e.g., a,b,c. If spaces are needed e.g., a, b, c let me know and I'll modify the code to produce that output.

Depend on your data and the number of records involved your query may take some time to run as function calls in queries slows them down a bit. I found that there is little benefit in optimizing the code in the function as the time to call the function is overwhelming. I hope this isn't a problem in your case.
 

Attachments

Last edited:
anyone want to test this:
Code: 
Public Function fnDiff(s1 As Variant, s2 As Variant) As String

    Dim strSource As String
    Dim strTarget As String
    Dim intOuterLoop As Integer
    Dim intInnerLoop As Integer
    Dim arrSource() As String
    Dim arrTarget() As String
    Dim intLowerBoundSource As Integer
    Dim intUpperBoundSource As Integer
    Dim intLowerBoundTarget As Integer
    Dim intUpperBoundTarget As Integer
    Dim intLowerBoundResult As Integer
    Dim intUpperBoundResult As Integer
    Dim strResult As String
    Dim bolSwap As Boolean
    Dim i As Integer
    Dim bolOKToAdd As Boolean
    
    s1 = s1 & ""
    s2 = s2 & ""
    
    If CountOccurrence(s1, ",") > CountOccurrence(s2, ",") Then
        bolSwap = True
        strSource = s2
        strTarget = s1
    Else
        strSource = s1
        strTarget = s2
    End If
    
    If strSource = vbNullString Then
        If InStrRev(strTarget, ",") = Len(strTarget) Then strTarget = left(strTarget, Len(strTarget) - 1)
        If InStr(strTarget, ",") = 1 Then strTarget = Mid(strTarget, 2)
        strResult = strTarget
        fnDiff = strTarget
        Exit Function
    End If
    If InStr(strSource, ",") = 0 Then
        ReDim arrSource(0)
        arrSource(0) = strSource
    Else
        arrSource = Split(strSource, ",")
    End If
    arrTarget = Split(strTarget, ",")
    intLowerBoundSource = LBound(arrSource)
    intUpperBoundSource = UBound(arrSource)
    intLowerBoundTarget = LBound(arrTarget)
    intUpperBoundTarget = UBound(arrTarget)
    ReDim arrResult(0)
    For intOuterLoop = intLowerBoundSource To intUpperBoundSource
        For intInnerLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrSource(intOuterLoop) = arrTarget(intInnerLoop) Then
                arrSource(intOuterLoop) = vbNullString
                arrTarget(intInnerLoop) = vbNullString
            End If
        Next intInnerLoop
    Next intOuterLoop
    For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
        For intInnerLoop = intLowerBoundSource To intUpperBoundSource
            If arrTarget(intOuterLoop) = arrSource(intInnerLoop) Then
                arrTarget(intOuterLoop) = vbNullString
                arrSource(intInnerLoop) = vbNullString
            End If
        Next intInnerLoop
    Next
    If bolSwap Then
        For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrTarget(intOuterLoop) <> vbNullString Then strResult = strResult & arrTarget(intOuterLoop) & ", "
        Next
        For intOuterLoop = intLowerBoundSource To intUpperBoundSource
            If arrSource(intOuterLoop) <> vbNullString Then strResult = strResult & arrSource(intOuterLoop) & ", "
        Next
    Else
        For intOuterLoop = intLowerBoundSource To intUpperBoundSource
            If arrSource(intOuterLoop) <> vbNullString Then strResult = strResult & arrSource(intOuterLoop) & ", "
        Next
        For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrTarget(intOuterLoop) <> vbNullString Then strResult = strResult & arrTarget(intOuterLoop) & ", "
        Next
    End If
    If Len(strResult) > 0 Then strResult = left(strResult, Len(strResult) - 2)
    fnDiff = strResult

End Function

Public Function CountOccurrence(ByVal strString As String, ByVal strStringToCount As String) As Integer

    Dim intCounter As Integer
    Dim intLoop As Integer
    Dim intStringLen As Integer
    
    intStringLen = Len(strString)
    For intLoop = 1 To intStringLen
        If Mid(strString, intLoop, 1) = strStringToCount Then intCounter = intCounter + 1
    Next
    ''intLoop = InStr(1, strString, strStringToCount)
    'While intLoop > 0
    '    intCounter = intCounter + 1
    '    intLoop = InStr(intLoop + 1, strString, strStringToCount)
    'Wend
    CountOccurrence = intCounter
    
End Function
 
mr arnelgp,

It gives an invalid procedure call on the statement

Left(strTarget, Len(strTarget) - 1)

when one the input strings is null. In debug I saw that strTarget was an empty string. I didn't check the specifics, i.e., which string or both. It works great when the strings are not null.
 
mr arnelgp,

Your function also didn't work for the original examples:

PrtNos1: CN-MSTGN-GN-GN-000, CN-MSTGN-GN-GN-010
PrtNos2: CN-110D0-ST-FM-010, CN-MSTGN-GN-GN-000, CN-MSTGN-GN-GN-010

as these have spaces after the commas. This is easy to fix just take out these spaces with the replace function.
 
mr.sneuberg, please if i can borrow your time.
Code: 
Public Function fnDiff(s1 As Variant, s2 As Variant) As String

    Dim strSource As String
    Dim strTarget As String
    Dim intOuterLoop As Integer
    Dim intInnerLoop As Integer
    Dim arrSource() As String
    Dim arrTarget() As String
    Dim intLowerBoundSource As Integer
    Dim intUpperBoundSource As Integer
    Dim intLowerBoundTarget As Integer
    Dim intUpperBoundTarget As Integer
    Dim intLowerBoundResult As Integer
    Dim intUpperBoundResult As Integer
    Dim strResult As String
    Dim bolSwap As Boolean
    Dim i As Integer
    Dim bolOKToAdd As Boolean
    Dim strTemp As String
    
    s1 = s1 & ""
    s2 = s2 & ""
    
    If CountOccurrence(s1, ",") > CountOccurrence(s2, ",") Then
        bolSwap = True
        strSource = s2
        strTarget = s1
    Else
        strSource = s1
        strTarget = s2
    End If
    
    If strSource = vbNullString Then
        If InStrRev(strTarget, ",") = Len(strTarget) Then strTarget = left(strTarget, Len(strTarget) - 1)
        If InStr(strTarget, ",") = 1 Then strTarget = Mid(strTarget, 2)
        strResult = strTarget
        fnDiff = strTarget
        Exit Function
    End If
    If InStr(strSource, ",") = 0 Then
        ReDim arrSource(0)
        arrSource(0) = strSource
    Else
        arrSource = Split(strSource, ",")
    End If
    arrTarget = Split(strTarget, ",")
    intLowerBoundSource = LBound(arrSource)
    intUpperBoundSource = UBound(arrSource)
    intLowerBoundTarget = LBound(arrTarget)
    intUpperBoundTarget = UBound(arrTarget)
    ReDim arrResult(0)
    'trim spaces
    For intOuterLoop = intLowerBoundSource To intUpperBoundSource
        arrSource(intOuterLoop) = RTrim(LTrim(arrSource(intOuterLoop)))
    Next
    For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
        arrTarget(intOuterLoop) = RTrim(LTrim(arrTarget(intOuterLoop)))
    Next
    'check for duplicate
    For intOuterLoop = intLowerBoundSource To intUpperBoundSource
        For intInnerLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrSource(intOuterLoop) = arrTarget(intInnerLoop) Then
                strTemp = strTemp & arrSource(intOuterLoop) & "|"
                arrSource(intOuterLoop) = vbNullString
                arrTarget(intInnerLoop) = vbNullString
            Else
                If InStr(strTemp, arrTarget(intInnerLoop)) > 0 Then arrTarget(intInnerLoop) = vbNullString
            End If
        Next intInnerLoop
    Next intOuterLoop
    For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
        For intInnerLoop = intLowerBoundSource To intUpperBoundSource
            If arrTarget(intOuterLoop) = arrSource(intInnerLoop) Then
                strTemp = strTemp & arrTarget(intOuterLoop) & "|"
                arrTarget(intOuterLoop) = vbNullString
                arrSource(intInnerLoop) = vbNullString
            Else
                If InStr(strTemp, arrSource(intInnerLoop)) > 0 Then arrSource(intInnerLoop) = vbNullString
            End If
        Next intInnerLoop
    Next
    'recheck duplicate, just make sure
    For intOuterLoop = intLowerBoundSource To intUpperBoundSource
        For intInnerLoop = intLowerBoundSource To intUpperBoundSource
            If intInnerLoop <> intOuterLoop Then
                If arrSource(intOuterLoop) = arrSource(intInnerLoop) Then arrSource(intInnerLoop) = vbNullString
            End If
        Next
    Next
    For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
        For intInnerLoop = intLowerBoundTarget To intUpperBoundTarget
            If intInnerLoop <> intOuterLoop Then
                If arrTarget(intOuterLoop) = arrTarget(intInnerLoop) Then arrTarget(intInnerLoop) = vbNullString
            End If
        Next
    Next
    If bolSwap Then
        For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrTarget(intOuterLoop) <> vbNullString Then strResult = strResult & arrTarget(intOuterLoop) & ", "
        Next
        For intOuterLoop = intLowerBoundSource To intUpperBoundSource
            If arrSource(intOuterLoop) <> vbNullString Then strResult = strResult & arrSource(intOuterLoop) & ", "
        Next
    Else
        For intOuterLoop = intLowerBoundSource To intUpperBoundSource
            If arrSource(intOuterLoop) <> vbNullString Then strResult = strResult & arrSource(intOuterLoop) & ", "
        Next
        For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrTarget(intOuterLoop) <> vbNullString Then strResult = strResult & arrTarget(intOuterLoop) & ", "
        Next
    End If
    If Len(strResult) > 0 Then strResult = left(strResult, Len(strResult) - 2)
    fnDiff = strResult

End Function
 
tried the above link using fnDiff("A,B,A,B", "A,A") the result is "B,B". since B is redundant it should only result in a single "B".
 
If we follow that logic, then
diff("A,B,A,B";"A,B") would give you nothing as a result...
The function i mentioned and elaborated by sneuberg will return "A,B".
If you really don't want the redundant results, just check the result array again to see if that value is already in it or not. If not don't add the value. But that would not be correct in my eyes.
PS : sorry, I didn't see that there was no offset given to the "IsInArray". But then again, you check also the order. So diff("A,B,C","A,C,B") will give you "B" (or "C" if you compare the second one with the first. Or combined it is "C,B")
So what do you actually want ?
 
Last edited:
of course it will give nothing, that is it all about, is it? which text on the field is not on the other field? or i get it wrong?
anyway it has already been resolved.
 
I agree with you anrelgp. It all depends what will be compared and in what order.
 
mr arnelgn,

The last version you posted fixed the problem with spaces after the commas, but still produces a invalid procedure call on null inputs.

Also your last version didn't include the CountOccurrence function. I used the one from your previous version to test. I suggest posting both for David, although I wonder if he is still interested in this. He hasn't posted anything for a while. I would have hoped he would be testing these as maybe our understanding of what he want isn't clear. Should we send him a private message and ask?
 
Last edited:
mr arnelgn,

I did some more specific tests. Your code only produces the invalid procedure call only if both s1 and s2 are null.
 
Last edited:
thank you sir for your time, i did some changes:
Code: 
Public Function fnDiff(s1 As Variant, s2 As Variant) As String

    Dim strSource As String
    Dim strTarget As String
    Dim intOuterLoop As Integer
    Dim intInnerLoop As Integer
    Dim arrSource() As String
    Dim arrTarget() As String
    Dim intLowerBoundSource As Integer
    Dim intUpperBoundSource As Integer
    Dim intLowerBoundTarget As Integer
    Dim intUpperBoundTarget As Integer
    Dim intLowerBoundResult As Integer
    Dim intUpperBoundResult As Integer
    Dim strResult As String
    Dim bolSwap As Boolean
    Dim i As Integer
    Dim bolOKToAdd As Boolean
    Dim strTemp As String
    
    s1 = s1 & ""
    s2 = s2 & ""
    
    If CountOccurrence(s1, ",") > CountOccurrence(s2, ",") Then
        bolSwap = True
        strSource = s2
        strTarget = s1
    Else
        strSource = s1
        strTarget = s2
    End If
    
    If strSource = vbNullString Then
        If InStrRev(strTarget, ",") = Len(strTarget) And strTarget <> "" Then strTarget = left(strTarget, Len(strTarget) - 1)
        If InStr(strTarget, ",") = 1 Then strTarget = Mid(strTarget, 2)
        strResult = strTarget
        fnDiff = strTarget
        Exit Function
    End If
    If InStr(strSource, ",") = 0 Then
        ReDim arrSource(0)
        arrSource(0) = strSource
    Else
        arrSource = Split(strSource, ",")
    End If
    arrTarget = Split(strTarget, ",")
    intLowerBoundSource = LBound(arrSource)
    intUpperBoundSource = UBound(arrSource)
    intLowerBoundTarget = LBound(arrTarget)
    intUpperBoundTarget = UBound(arrTarget)
    ReDim arrResult(0)
    'trim spaces
    For intOuterLoop = intLowerBoundSource To intUpperBoundSource
        arrSource(intOuterLoop) = RTrim(LTrim(arrSource(intOuterLoop)))
    Next
    For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
        arrTarget(intOuterLoop) = RTrim(LTrim(arrTarget(intOuterLoop)))
    Next
    'check for duplicate
    For intOuterLoop = intLowerBoundSource To intUpperBoundSource
        For intInnerLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrSource(intOuterLoop) = arrTarget(intInnerLoop) Then
                strTemp = strTemp & arrSource(intOuterLoop) & "|"
                arrSource(intOuterLoop) = vbNullString
                arrTarget(intInnerLoop) = vbNullString
            Else
                If InStr(strTemp, arrTarget(intInnerLoop)) > 0 Then arrTarget(intInnerLoop) = vbNullString
            End If
        Next intInnerLoop
    Next intOuterLoop
    For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
        For intInnerLoop = intLowerBoundSource To intUpperBoundSource
            If arrTarget(intOuterLoop) = arrSource(intInnerLoop) Then
                strTemp = strTemp & arrTarget(intOuterLoop) & "|"
                arrTarget(intOuterLoop) = vbNullString
                arrSource(intInnerLoop) = vbNullString
            Else
                If InStr(strTemp, arrSource(intInnerLoop)) > 0 Then arrSource(intInnerLoop) = vbNullString
            End If
        Next intInnerLoop
    Next
    'recheck duplicate, just make sure
    For intOuterLoop = intLowerBoundSource To intUpperBoundSource
        For intInnerLoop = intLowerBoundSource To intUpperBoundSource
            If intInnerLoop <> intOuterLoop Then
                If arrSource(intOuterLoop) = arrSource(intInnerLoop) Then arrSource(intInnerLoop) = vbNullString
            End If
        Next
    Next
    For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
        For intInnerLoop = intLowerBoundTarget To intUpperBoundTarget
            If intInnerLoop <> intOuterLoop Then
                If arrTarget(intOuterLoop) = arrTarget(intInnerLoop) Then arrTarget(intInnerLoop) = vbNullString
            End If
        Next
    Next
    If bolSwap Then
        For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrTarget(intOuterLoop) <> vbNullString Then strResult = strResult & arrTarget(intOuterLoop) & ", "
        Next
        For intOuterLoop = intLowerBoundSource To intUpperBoundSource
            If arrSource(intOuterLoop) <> vbNullString Then strResult = strResult & arrSource(intOuterLoop) & ", "
        Next
    Else
        For intOuterLoop = intLowerBoundSource To intUpperBoundSource
            If arrSource(intOuterLoop) <> vbNullString Then strResult = strResult & arrSource(intOuterLoop) & ", "
        Next
        For intOuterLoop = intLowerBoundTarget To intUpperBoundTarget
            If arrTarget(intOuterLoop) <> vbNullString Then strResult = strResult & arrTarget(intOuterLoop) & ", "
        Next
    End If
    If Len(strResult) > 0 Then strResult = left(strResult, Len(strResult) - 2)
    fnDiff = strResult

End Function

Public Function CountOccurrence(ByVal strString As String, ByVal strStringToCount As String) As Integer

    Dim intCounter As Integer
    Dim intLoop As Integer
    Dim intStringLen As Integer
    
    intStringLen = Len(strString)
    For intLoop = 1 To intStringLen
        If Mid(strString, intLoop, 1) = strStringToCount Then intCounter = intCounter + 1
    Next
    ''intLoop = InStr(1, strString, strStringToCount)
    'While intLoop > 0
    '    intCounter = intCounter + 1
    '    intLoop = InStr(intLoop + 1, strString, strStringToCount)
    'Wend
    CountOccurrence = intCounter
    
End Function
 
mr arnelgn,

Couldn't break it this time. Looks good. I'd let David know it's ready.
 
You must log in or register to reply here.

Similar threads

B
Test if a compound. (two or more joined fields) exists
Replies
7
Views
361
Pat Hartman
P
asteropi
Solved How to format ascending numbers for different inputs?
2
Replies
39
Views
903
asteropi
asteropi
F
Your Query does not include the specified Expression ‘ID’ as part of an Aggregate Function
Replies
8
Views
612
June7
June7
H
Extract a variable number of parts of text from a string
2
Replies
26
Views
521
AHeyne
A
MajP
The Microsoft Engine Does not Recognize... as a Valid Field Name in CrossTab
Replies
5
Views
290
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom