ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Same Contents, Regardless of Order (https://www.excelbanter.com/excel-programming/412674-same-contents-regardless-order.html)

Gary''s Student
Same Contents, Regardless of Order
 
I need a Boolean function that, given two input arrays of equal size, will
return TRUE if the contents of the arrays are the same (apart from order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx

Jim Thomlinson
Same Contents, Regardless of Order
 
This should do it. The only way that I know of is a brute force attack.

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit For
End If
blnFound = False
Next lngAry1
End Function
--
HTH...

Jim Thomlinson


"Gary''s Student" wrote:

I need a Boolean function that, given two input arrays of equal size, will
return TRUE if the contents of the arrays are the same (apart from order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx

Jim Thomlinson
Same Contents, Regardless of Order
 
Oops that does not quite work... Try this one...

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary3, ary1)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry1

For lngAry2 = LBound(ary2) To UBound(ary2)
For lngAry1 = LBound(ary1) To UBound(ary1)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry1
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry2
End Function
--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

This should do it. The only way that I know of is a brute force attack.

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit For
End If
blnFound = False
Next lngAry1
End Function
--
HTH...

Jim Thomlinson


"Gary''s Student" wrote:

I need a Boolean function that, given two input arrays of equal size, will
return TRUE if the contents of the arrays are the same (apart from order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx

Rick Rothstein \(MVP - VB\)[_2140_]
Same Contents, Regardless of Order
 
I get False with this set up...

Dim Arr1(4 To 7) As Long
Dim Arr2(7 To 10) As Long
Arr1(4) = 4
Arr1(5) = 2
Arr1(6) = 3
Arr1(7) = 1
Arr2(7) = 1
Arr2(8) = 2
Arr2(9) = 4
Arr2(10) = 3

Rick


"Jim Thomlinson" wrote in message
...
Oops that does not quite work... Try this one...

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary3, ary1)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry1

For lngAry2 = LBound(ary2) To UBound(ary2)
For lngAry1 = LBound(ary1) To UBound(ary1)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry1
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry2
End Function
--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

This should do it. The only way that I know of is a brute force attack.

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As
Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit For
End If
blnFound = False
Next lngAry1
End Function
--
HTH...

Jim Thomlinson


"Gary''s Student" wrote:

I need a Boolean function that, given two input arrays of equal size,
will
return TRUE if the contents of the arrays are the same (apart from
order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx


Gary''s Student
Same Contents, Regardless of Order
 
Thanks Jim......it looks great!
--
Gary''s Student - gsnu200792


"Jim Thomlinson" wrote:

Oops that does not quite work... Try this one...

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary3, ary1)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry1

For lngAry2 = LBound(ary2) To UBound(ary2)
For lngAry1 = LBound(ary1) To UBound(ary1)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry1
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry2
End Function
--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

This should do it. The only way that I know of is a brute force attack.

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit For
End If
blnFound = False
Next lngAry1
End Function
--
HTH...

Jim Thomlinson


"Gary''s Student" wrote:

I need a Boolean function that, given two input arrays of equal size, will
return TRUE if the contents of the arrays are the same (apart from order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx

Rick Rothstein \(MVP - VB\)[_2141_]
Same Contents, Regardless of Order
 
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


"Gary''s Student" wrote in message
...
I need a Boolean function that, given two input arrays of equal size, will
return TRUE if the contents of the arrays are the same (apart from order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx


Rick Rothstein \(MVP - VB\)[_2142_]
Same Contents, Regardless of Order
 
Changing this line...

If UBound(ary1) < UBound(ary2) Then

to this line...

If UBound(ary1) - LBound(ary1) < UBound(ary2) - LBound(ary2) Then

appears to correct the problem.

Rick


"Rick Rothstein (MVP - VB)" wrote in
message ...
I get False with this set up...

Dim Arr1(4 To 7) As Long
Dim Arr2(7 To 10) As Long
Arr1(4) = 4
Arr1(5) = 2
Arr1(6) = 3
Arr1(7) = 1
Arr2(7) = 1
Arr2(8) = 2
Arr2(9) = 4
Arr2(10) = 3

Rick


"Jim Thomlinson" wrote in
message ...
Oops that does not quite work... Try this one...

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary3, ary1)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As
Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry1

For lngAry2 = LBound(ary2) To UBound(ary2)
For lngAry1 = LBound(ary1) To UBound(ary1)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry1
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry2
End Function
--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

This should do it. The only way that I know of is a brute force attack.

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As
Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit For
End If
blnFound = False
Next lngAry1
End Function
--
HTH...

Jim Thomlinson


"Gary''s Student" wrote:

I need a Boolean function that, given two input arrays of equal size,
will
return TRUE if the contents of the arrays are the same (apart from
order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx

Gary''s Student
Same Contents, Regardless of Order
 
Thanks...I was sorting the arrays and then comparing them item-by-item.

Both your code and Jim's were mush faster than mine.
--
Gary''s Student - gsnu200792


"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


"Gary''s Student" wrote in message
...
I need a Boolean function that, given two input arrays of equal size, will
return TRUE if the contents of the arrays are the same (apart from order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx



Rick Rothstein \(MVP - VB\)[_2145_]
Same Contents, Regardless of Order
 
I think I spotted a flaw in Jim's method. Try this subroutine with Jim's
function (I get it to return True even though the two arrays are clearly
different)...

Sub Test()
Dim Arr1(0 To 3) As Variant
Dim Arr2(0 To 3) As Variant
' First Array
Arr1(0) = 4
Arr1(1) = 4
Arr1(2) = 3
Arr1(3) = 1
' Second Array
Arr2(0) = 1
Arr2(1) = 3
Arr2(2) = 4
Arr2(3) = 3
Debug.Print ArrayCompare(Arr1, Arr2)
End Sub

Rick


"Gary''s Student" wrote in message
...
Thanks Jim......it looks great!
--
Gary''s Student - gsnu200792


"Jim Thomlinson" wrote:

Oops that does not quite work... Try this one...

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary3, ary1)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As
Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry1

For lngAry2 = LBound(ary2) To UBound(ary2)
For lngAry1 = LBound(ary1) To UBound(ary1)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry1
If blnFound = False Then
ArrayCompare = False
Exit Function
End If
blnFound = False
Next lngAry2
End Function
--
HTH...

Jim Thomlinson


"Jim Thomlinson" wrote:

This should do it. The only way that I know of is a brute force attack.

Sub Test()
Dim ary1 As Variant
Dim ary2 As Variant
Dim ary3 As Variant
Dim ary4 As Variant

ary1 = Array(1, 2, 3, 4, 5, 6)
ary2 = Array(1, 6, 4, 3, 5, 2)
ary3 = Array(1, 1, 4, 3, 5, 2)
ary4 = Array(1, 2, 3, 4, 5, 6, 7)

MsgBox ArrayCompare(ary1, ary2)
MsgBox ArrayCompare(ary1, ary3)
MsgBox ArrayCompare(ary2, ary4)


End Sub


Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As
Variant)
As Boolean
Dim lngAry1 As Long
Dim lngAry2 As Long
Dim blnFound As Boolean

ArrayCompare = True
If UBound(ary1) < UBound(ary2) Then
ArrayCompare = False
Exit Function
End If

blnFound = False
For lngAry1 = LBound(ary1) To UBound(ary1)
For lngAry2 = LBound(ary2) To UBound(ary2)
If ary1(lngAry1) = ary2(lngAry2) Then
blnFound = True
Exit For
End If
Next lngAry2
If blnFound = False Then
ArrayCompare = False
Exit For
End If
blnFound = False
Next lngAry1
End Function
--
HTH...

Jim Thomlinson


"Gary''s Student" wrote:

I need a Boolean function that, given two input arrays of equal size,
will
return TRUE if the contents of the arrays are the same (apart from
order),
otherwise FALSE.

For example, if array 1 contained:
1,2,3,4
and array 2 contained:
2,3,1,4
then the function should return TRUE


If array 1 contained:
1,1,6,7
and array 2 contained:
7,1,6,2
then the function should return FALSE.

--
Gary''s Student - gsnu2007xx


Ron Rosenfeld
Same Contents, Regardless of Order
 
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

Ron Rosenfeld
Same Contents, Regardless of Order
 
On Tue, 17 Jun 2008 07:18:28 -0400, Ron Rosenfeld
wrote:

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.

Actually, the Extract function can be simplified:

=======================
Private Function Extract(a) As Variant
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
Extract = temp
Else
Extract = a
End If
End Function
=========================
--ron

Gary''s Student
Same Contents, Regardless of Order
 
This is very interesting!!

I guess the reason I did not hit a problem was that I did the sorts in-line
rather than thru another function call.

In any case, I like your bi-directional cross-check much better.

Thanks again!!
--
Gary''s Student - gsnu200792


"Ron Rosenfeld" wrote:

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

Ron Rosenfeld
Same Contents, Regardless of Order
 
On Tue, 17 Jun 2008 10:16:02 -0700, Gary''s Student
wrote:

This is very interesting!!

I guess the reason I did not hit a problem was that I did the sorts in-line
rather than thru another function call.

In any case, I like your bi-directional cross-check much better.

Thanks again!!
--
Gary''s Student - gsnu200792

Gary''s Student,

I'm not sure if you are responding to me or to Rick. But if to me, how is the
speed of my routine on your data compared with the others?

Is it worthwhile coding a faster sort routine?

Thanks.

--ron
--ron


All times are GMT +1. The time now is 02:30 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com