VBA: Have two sets of user inputs. Need to check if any sequential *pairs* of input are replicated b-CodePudding

I will try to condense this into a general sense. I have an Excel sheet with two different sets of cells that require user input. The first sets has 8 inputs, the second set has 5.

Let's say the Data Sets One and Two have user inputs of letters, like so:

DataSetOne(0) = A
DataSetOne(1) = B
DataSetOne(2) = C
DataSetOne(3) = D
DataSetOne(4) = E
DataSetOne(5) = F
DataSetOne(6) = G
DataSetOne(7) = H

DataSetTwo(0) = A
DataSetTwo(1) = B
DataSetTwo(2) = H
DataSetTwo(3) = D
DataSetTwo(4) = C

I need to check the two sets for replicated data. However, I only care if any two side-by-side values are repeated, not just single values.

For example, Data Set One contains seven sequential "pairs" of input data:

Pair 1 = A, B
Pair 2 = B, C
Pair 3 = C, D
Pair 4 = D, E
Pair 5 = E, F
Pair 6 = F, G
Pair 7 = G, H

And similarly, Data Set Two have four additional pairs of data:

Pair 8 = A, B
Pair 9 = B, H
Pair 10 = H, D
Pair 12 = D, C

I need to see if any of these pairs match. Order does not matter - as long as two pairs have the same two individual inputs, I need to make a decision one way. If the pairs do not contain both matching values , then my decision goes a different way.

So in the above example, I need my code to recognize matches between:

Pair 1 and Pair 8
Pair 3 and Pair 12

Based on this, my code would do one thing. Meanwhile all of the other pairs, since they do not contain two matching/identical values, would do a different thing. I feel like this should be relatively simple yet I can't figure out how to do it. Any help appreciated. Thank you.

CodePudding user response：

To find the duplicates, i.e. values present in both of the lists, the easiest way to implement is to simply do a brute force search iterating over both lists. Depending on your application, this may be good enough.

For example:

Public Sub SO70184805_find_duplicates()

    Dim DataSetOne(0 To 7) As String
    Dim DataSetTwo(0 To 4) As String
    
    Const Delimiter As String = ", "
    
    DataSetOne(0) = "A"
    DataSetOne(1) = "B"
    DataSetOne(2) = "C"
    DataSetOne(3) = "D"
    DataSetOne(4) = "E"
    DataSetOne(5) = "F"
    DataSetOne(6) = "G"
    DataSetOne(7) = "H"
    
    DataSetTwo(0) = "A"
    DataSetTwo(1) = "B"
    DataSetTwo(2) = "H"
    DataSetTwo(3) = "D"
    DataSetTwo(4) = "C"
    
    Dim PairsOne(0 To 6) As String
    Dim PairsTwo(0 To 3) As String
    
    Dim I As Integer
    Dim S1 As Variant
    Dim S2 As Variant
        
    'Make the lists of pairs
    Debug.Print "Pairs from the first list:"
    For I = 0 To 6
        If (DataSetOne(I) < DataSetOne(I   1)) Then
            PairsOne(I) = DataSetOne(I) & Delimiter & DataSetOne(I   1)
        Else
            PairsOne(I) = DataSetOne(I   1) & Delimiter & DataSetOne(I)
        End If
        Debug.Print (PairsOne(I))
    Next I
    
    Debug.Print
    Debug.Print "Pairs from the second list:"
    For I = 0 To 3
        If (DataSetTwo(I) < DataSetTwo(I   1)) Then
            PairsTwo(I) = DataSetTwo(I) & Delimiter & DataSetTwo(I   1)
        Else
            PairsTwo(I) = DataSetTwo(I   1) & Delimiter & DataSetTwo(I)
        End If
        Debug.Print (PairsTwo(I))
    Next I
    
    Debug.Print
    Debug.Print ("Duplicates:"):
    
    Dim NumberOfDuplicates As Integer
    NumberOfDuplicates = 0
    For Each S1 In PairsOne
        For Each S2 In PairsTwo
            If (S1 = S2) Then
                Debug.Print (S1)
                NumberOfDuplicates = NumberOfDuplicates   1
             End If
        Next
    Next
End Sub

This is the output:

Pairs from the first list:
A, B
B, C
C, D
D, E
E, F
F, G
G, H

Pairs from the second list:
A, B
B, H
D, H
C, D

Duplicates:
A, B
C, D

CodePudding user response：

Something along these lines, i'm heading off home now so can't do much more. I'll revisit later if possible. You'll need to add the scripting runtime reference to use the dictionary.

Sub datasets()

Dim datasetone(7) As String
Dim datasettwo(4) As String
Dim dicPairsOne As New Scripting.Dictionary
Dim dicPairsTwo As New Scripting.Dictionary
Dim l As Long
Dim strPair As String

datasetone(0) = "A"
datasetone(1) = "B"
datasetone(2) = "C"
datasetone(3) = "D"
datasetone(4) = "E"
datasetone(5) = "F"
datasetone(6) = "G"
datasetone(7) = "H"

datasettwo(0) = "A"
datasettwo(1) = "B"
datasettwo(2) = "H"
datasettwo(3) = "D"
datasettwo(4) = "C"

For l = 0 To UBound(datasetone) - 1

    strPair = datasetone(l) & "," & datasetone(l   1)
    
    If Not dicPairsOne.Exists(strPair) Then
        dicPairsOne.Add strPair, 1
    Else
        dicPairsOne(strPair) = dicPairsOne(strPair)   1
    End If
    
    If Not dicPairsOne.Exists(StrReverse(strPair)) Then
        dicPairsOne.Add StrReverse(strPair), 1
    Else
        dicPairsOne(StrReverse(strPair)) = dicPairsOne(StrReverse(strPair))   1
    End If

Next l

For l = 0 To UBound(datasettwo) - 1

    strPair = datasettwo(l) & "," & datasettwo(l   1)
    
    If Not dicPairsTwo.Exists(strPair) Then
        dicPairsTwo.Add strPair, 1
    Else
        dicPairsTwo(strPair) = dicPairsTwo(strPair)   1
    End If

Next l

For l = 0 To dicPairsOne.Count - 1
    If dicPairsTwo.Exists(dicPairsOne.Keys()(l)) Then
        Debug.Print dicPairsOne.Keys()(l)
    End If
Next l

End Sub