On Mon, 16 Jun 2008 16:01:51 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

This was a good problem! I'm almost completely sure<g that this function
works correctly (with text or numeric arrays or Variant arrays containing
text or numeric values)...

Function IsSameContent(ByVal Arr1 As Variant, _
ByVal Arr2 As Variant) As Boolean
Dim X As Long
Dim Count() As Long
Dim ArrayString As String
If (VarType(Arr1) < vbArray) Or (VarType(Arr2) < vbArray) Or _
(UBound(Arr1) - LBound(Arr1) < UBound(Arr2) - LBound(Arr2)) Then
Exit Function
End If
ReDim Count(0 To UBound(Arr1) - LBound(Arr1))
ArrayString = Chr$(1)
For X = LBound(Arr1) To UBound(Arr1)
ArrayString = CStr(ArrayString) & Arr1(X) & Chr$(1)
Next
IsSameContent = True
For X = LBound(Arr2) To UBound(Arr2)
If InStr(ArrayString, Chr$(1) & Arr2(X) & Chr$(1)) = 0 Then
IsSameContent = False
Exit Function
Else
ArrayString = Replace(ArrayString, Arr2(X), "", , 1)
End If
Next
End Function


Rick

Rick,

I've been fooling around with this, and with my own version which sorts the
array and then compares item for item. And I ran into an issue (XL2007)
whereby if the arguments for the function is a range reference, rather than an
array constant, then the function fails. In particular, it fails when trying
to use the Ubound method, since the argument is an object. This is true even
when passing the argument ByVal.

I worked around this by testing to see if the argument was an object or not,
and using the Count property if it was an object, but I wonder if there is a
more efficient method.

Any thoughts?

(I did not bother to test, as you did, to make sure that the references passed
were arrays -- being OK with the #VALUE! error being returned in that
instance).

Also, whether the argument being passed was an array constant, or a range
reference, the vartype was 8204.

Here's my effort. I used a simple Bubblesort routine, although I know there
are faster algorithms.

=======================================
Function CompArr(ByVal Array1, ByVal Array2) As Boolean
Dim a1 As Variant, a2 As Variant

a1 = Extract(Array1)
a2 = Extract(Array2)

CompArr = True

If UBound(a1) < UBound(a2) Then
CompArr = False
Exit Function
End If

BubbleSort a1
BubbleSort a2

For i = 1 To UBound(a1)
If a1(i) < a2(i) Then
CompArr = False
Exit Function
End If
Next i
End Function
Private Sub BubbleSort(TempArray As Variant)
Dim temp As Variant
Dim i As Integer
Dim NoExchanges As Integer

' Loop until no more "exchanges" are made.
Do
NoExchanges = True

' Loop through each element in the array.
For i = 1 To UBound(TempArray) - 1

' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) TempArray(i + 1) Then
NoExchanges = False
temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = temp
End If
Next i
Loop While Not (NoExchanges)
End Sub
Private Function Extract(a) As Variant
Dim o As Object
Dim i As Long
Dim temp() As Variant

If IsObject(a) Then
ReDim temp(1 To a.Count)
For i = 1 To a.Count
temp(i) = a(i)
Next i
Else
ReDim temp(1 To UBound(a))
For i = 1 To UBound(a)
temp(i) = a(i)
Next i
End If
Extract = temp
End Function
==================================
--ron