How do I find common elements in two different arrays<

[keelaboosa]

Array 1 = {"DX";"DZ";"WX";"TX";0;0;0;0;0}
Array 2 = {"BX";"CX";"DS";"EX";"FX";"HX";"IX";"KX";"LK";"N";"NX";"OP";"SK";"SX";"TX";"WX";"ZX";0;0;0}

How do I make an array that combines elements common to both arrays that aren't 0? I'd expect {"WX";"TX"} as a result.

 

[rlv01]

One way

Sub UniqueElements()
    Dim SD1 As Object, SD2 As Object
    Dim KeyValue As String
    Dim I As Long, J As Long
    Dim Array1, Array2
    Dim Array3()    'Dynamic array for common elements.

    'Array 1 = {"DX";"DZ";"WX";"TX";0;0;0;0;0}
    'Array 2 = {"BX";"CX";"DS";"EX";"FX";"HX";"IX";"KX";"LK";"N";"NX";"OP";"SK";"SX";"TX";"WX";"ZX";0;0;0}

    Array1 = Array("DX", "DZ", "WX", "TX", 0, 0, 0, 0, 0)
    Array2 = Array("BX", "CX", "DS", "EX", "FX", "HX", "IX", "KX", "LK", "N", "NX", "OP", "SK", "SX", "TX", "WX", "ZX", 0, 0, 0, "WX", "WX", "WX", "WX", "WX", "WX")

    ReDim Array3(UBound(Array1) + UBound(Array2))
    Set SD1 = CreateObject("Scripting.dictionary")
    Set SD2 = CreateObject("Scripting.dictionary")

    For I = 0 To UBound(Array1)
        KeyValue = Array1(I)
        If Not SD1.exists(KeyValue) Then   
            SD1.Add KeyValue, vbNullString      'Unique key value, not already in the dictionary
        End If
    Next I

    J = 0
    For I = 0 To UBound(Array2)
        KeyValue = Array2(I)
        If Not SD2.exists(KeyValue) Then    
            SD2.Add KeyValue, vbNullString      'Unique key value, not already in the dictionary
            If SD1.exists(KeyValue) Then   
                Select Case KeyValue  
                Case 0
                Case Else
                    Array3(J) = KeyValue             'Common element
                    J = J + 1
                End Select
            End If
        End If
    Next I

    ReDim Preserve Array3(J - 1)
    Debug.Print UBound(Array3) + 1 & " non-zero common elements found"
    Set SD1 = Nothing
    Set SD2 = Nothing
End Sub

 

[iliace]

Another way, similar but without using Dictionary or Collection: start with the shorter array, and match through the elements. Something like:

Public Sub GetMatchingElements()
  Dim vArray3 As Variant
  Dim v1 As Variant
  Dim v2 As Variant
  
  Dim sFormat As String
  
  Dim i As Long
  
  v1 = Array("DX", "DZ", "WX", "TX", 0, 0, 0, 0, 0)
  v2 = Array("BX", "CX", "DS", "EX", "FX", "HX", "IX", "KX", "LK", "N", "NX", "OP", "SK", "SX", "TX", "WX", "ZX", 0, 0, 0, "WX", "WX", "WX", "WX", "WX", "WX")
  
  i = iMatchElements(v1, v2, vArray3)
  i = Application.WorksheetFunction.RoundUp((Log(i) + 1) / Log(10), 0)
  
  sFormat = Application.WorksheetFunction.Rept("0", i)
  
  For i = LBound(vArray3) To UBound(vArray3)
    Debug.Print Format(i, sFormat) & ":", vArray3(i)
  Next i
End Sub

Private Function iMatchElements(v1 As Variant, v2 As Variant, ByRef vArray3 As Variant) As Long
  Dim vShorter As Variant
  Dim vLonger As Variant
  Dim iSize As Long
  Dim iPos As Long
  
  Dim i As Long
  
  iSize = Application.Min(UBound(v1), UBound(v2))
  If iSize = UBound(v1) Then
    vShorter = v1
    vLonger = v2
  Else
    vShorter = v2
    vLonger = v1
  End If
  
  ReDim vArray3(1 To iSize)
  iPos = 0
  
  For i = LBound(vShorter) To UBound(vShorter)
    If vShorter(i) <> 0 Then
      On Error Resume Next
        If IsNumeric(Application.Match(vShorter(i), vLonger, 0)) Then
          iPos = iPos + 1
          vArray3(iPos) = vShorter(i)
        End If
      On Error GoTo 0
    End If
  Next i
  
  If iPos < i Then
    ReDim Preserve vArray3(1 To iPos)
  End If
  
  iMatchElements = iPos
End Function

Can't say off top of my head which way would be better - it might depend on the size of the initial arrays.

 

[keelaboosa]

Thanks for the suggestions guys!

I'm trying to make a data validation list dependent upon three separate tables . I've previous used the first array as returned from an INDEX-MATCH formula referencing two separate tables and an element common between the two. I've now got another condition to throw in the mix, which is the second array.

I'm hoping I can leave the formulas I'm using out of the discussion and just deal with the arrays they return.

I was hoping there was a way to build this "common" array in a way that could be used as a data validation list.

I hope that helps!

 

[mikerickson]

Perhaps something like this.

Sub test()
    Const Delimiter As String = ","
    
    Dim ArrayShort As Variant
    Dim ArrayLong As Variant
    Dim strBoth As String
    Dim i As Long
    Dim CellForList As Range
    
    Set CellForList = Range("G5"): Rem adjust

    Rem given array
    ArrayShort = Application.Transpose(Range("A1:A9").Value)
    ArrayLong = Application.Transpose(Range("B1:B20").Value)
    ' or
    ArrayShort = Array("BX", "CX", "DS", "EX", "FX", "HX", "IX", "KX", "LK", "N", "NX", "OP", "SK", "SX", "TX", "WX", "ZX", 0, 0, 0)
    ArrayLong = Array("DX", "DZ", "WX", "TX", 0, 0, 0, 0, 0)
    
    
    If UBound(ArrayLong) < UBound(ArrayShort) Then
        strBoth = Join(ArrayLong, Delimiter)
        ArrayLong = ArrayShort
        ArrayShort = Split(strBoth, Delimiter)
    End If
    
    strBoth = vbNullString
    Rem find dups
    For i = LBound(ArrayShort) To UBound(ArrayShort)
        If IsNumeric(Application.Match(ArrayShort(i), ArrayLong, 0)) Then
            If ArrayShort(i) <> 0 Then
                strBoth = strBoth & Delimiter & ArrayShort(i)
            End If
        End If
    Next i
    
    strBoth = Mid(strBoth, 2)

    Rem set validation list
    With CellForList.Validation
        .Delete
        .Add Formula1:=strBoth, Type:=xlValidateList _
            , AlertStyle:=xlValidAlertStop, Operator:=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

 

[Fluff]

Another option

Sub test()

   Dim Ary1 As Variant
   Dim Ary2 As Variant
   Dim Ary3() As Variant
   Dim i As Long, j As Long
   
   Ary1 = Array("DX", "DZ", "WX", "TX", 0, 0, 0, 0, 0)
   Ary2 = Array("BX", "CX", "DS", "EX", "FX", "HX", "IX", "KX", "LK", "N", "NX", "OP", "SK", "SX", "TX", "WX", "ZX", 0, 0, 0, "WX", "WX", "WX", "WX", "WX", "WX")
   
   For i = LBound(Ary1) To UBound(Ary1)
      If Not Ary1(i) = 0 Then
         If UBound(Filter(Ary2, Ary1(i), True, vbTextCompare)) >= 0 Then
            ReDim Preserve Ary3(0 To j)
            Ary3(j) = Ary1(i)
            j = j + 1
         End If
      End If
   Next i
   With Range("C5").Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
         Operator:=xlBetween, Formula1:=Join(Ary3, ",")
      .IgnoreBlank = True
      .InCellDropdown = True
      .ShowInput = True
      .ShowError = True
   End With
End Sub

 

[keelaboosa]

Thanks to everyone for your time and consideration on this. I really appreciate it! This spreadsheet now does things my users never thought possible, and I look like a genius.

 

[Fluff]

Glad we could help & thanks for the feedback