Function FieldsCross(ar1() As Variant, ar2() As Variant)

   Dim arF() As Variant
   Dim ar(), br() As Variant
   Dim l1, l2 As Integer
   Dim i As Integer
   
   l1 = UBound(ar1)
   l2 = UBound(ar2)
   
   If (l1 >= l2) Then
       ar = ar1
       br = ar2
       ReDim Preserve arF( 0  To l2) 
   Else
       ar = ar2
       br = ar1
       ReDim Preserve arF( 0  To l1) 
   End If
   
   i =  0 
   For Each a In ar
    For Each b In br
        If (a = b) Then
            arF(i) = a
            i = i +  1 
        End If
    Next
   Next

   i = i -  1 
   ReDim Preserve arF( 0  To i) 
   FieldsCross = arF
   
End Function