SET THEORY & VBA ?

[jay dean]

Hello -

Is there a way to perform set operations in VBA? Example: If
rng1=Range("A1:A2000") and rng1=range("C1:C2000") containing strings --
numbers,text or both, is there a way to perform operations like
"intersection", "subset", and "union" that produces a range, containing
the result?

If not, can this be done with excel functions or formulas?

Any help will be appreciated!

Thanks
Jay


*** Sent via Developersdex http://www.developersdex.com ***

 

[Simon Lloyd]

I have very little idea of what you want to achieve as your explanation
is sketchy to say the least, however you don't need to use VBA for you
explanation, you need a worksheet function SUMPRODUCT, the master of
SUMPRODUCT (Bob Phillips) is currently giving tutorials on it here
'SUMPRODUCT And Other Array Functions - VBA Express Forum'
(http://www.vbaexpress.com/forum/forumdisplay.php?f=98)

Hello -

Is there a way to perform set operations in VBA? Example: If
rng1=Range("A1:A2000") and rng1=range("C1:C2000") containing strings --
numbers,text or both, is there a way to perform operations like
"intersection", "subset", and "union" that produces a range, containing
the result?

If not, can this be done with excel functions or formulas?

Any help will be appreciated!

Thanks
Jay


*** Sent via Developersdex 'Developersdex.com - The Web Developers
Index and Directory' (http://www.developersdex.com) ***

--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)

 

[OssieMac]

Hi Jay,

Can't say that I am sure that I really understand the question but perhaps
the following example might help.

Sub test2()

Dim rng1 As Range
Dim rng2 As Range
Dim rngUnion As Range
Dim isect As Range

Set rng1 = Range("A1:A2000")
Set rng2 = Range("C1:C2000")

Set rngUnion = Union(rng1, rng2)

MsgBox rngUnion.Address

Set isect = Intersect(rng1, rng2)

If isect Is Nothing Then
MsgBox "Ranges do NOT intersect"
Else
MsgBox "Ranges DO intersect"
End If

Set isect = Intersect(rng1, rngUnion)

If isect Is Nothing Then
MsgBox "Ranges do NOT intersect"
Else
MsgBox "Ranges DO intersectat " & isect.Address
End If


End Sub

 

[Sam Wilson]

Hi Jay,

You mean set theory as in pure maths, right?

There are no functions (as far as I know...) in excel that will do what
you're after, but you could certainly write routines that would do it. The
intersect mentioned by OssieMac would only return a result if the two ranges
physically overlapped, regardless of whether there were any common values.

You'd have to write the routines to apply to just two sets (two ranges) to
keep it simple. You can then apply the routine to the result of running the
routine and a third set etc to get a union/intersect over three sets.

Without writing it for you, this is how I'd proceed for intersect:

1. You need a for each... loop to roll through each cell in range 1
2. You need a second for each... loop to roll through each cell in range 2
3. You need a results array to store any common values
4. For each cell in loop1, look at each cell returned by loop2, if the
values are the same, add the value to the results array.

Hope that's a point in the right direction.

 

[jay dean]

Thanks, Simon, Ossie Mac, and Sam for your responses.
@ Sam, yes, that was what I was looking for. I understand I can easily
combine any 2 loops like a For-For, For-Do, Do-For, While-For, etc, to
accomplish this, but for a large range I don't want to wait forever. I
thought VBA had efficient built-in functions like "ismember()"e.t.c as
Matlab does. Or, even formulas in Excel?

Anyway, for those who didn't understand what I was looking for: I was
talking about Mathematical Set Theory. Example:
1. rng1 "intersection" rng2 should yield a range containing "values"
common to values in both ranges.

2. rng1 "union" rng2 should yield a range containing values in each
range (without repetitions).

3. rng2 will be a subset of rng1, if all elements (values) in rng2 can
be found in rng1. In this case, the result will be a Boolean.."true" if
yes, and "false" if no.

Sorry, I didn't explain myself better.

Jay

*** Sent via Developersdex http://www.developersdex.com ***

 

[Bernie Deitrick]

Jay,

The code below requires a reference to MS Scripting Runtime....

The code works on columns A and C, with output to D and E for the intersection and union, and it
gives a msgbox for subset....

HTH,
Bernie
MS Excel MVP


Sub GetIntersection()
Dim myInt As Variant
Dim i As Integer
myInt = CommUniqueValues(Range("A1:A10"), Range("C1:C10"))
Range("D1").Resize(UBound(myInt) - LBound(myInt) + 1).Value = _
Application.Transpose(myInt)
End Sub

Sub GetUnion()
Dim myUnion As Variant
Dim i As Integer
myUnion = AllUniqueValues(Range("A1:A10"), Range("C1:C10"))
Range("E1").Resize(UBound(myUnion) - LBound(myUnion) + 1).Value = _
Application.Transpose(myUnion)
End Sub

Sub IsItASubSet()
'is the first range a subset of the second?
MsgBox "A is a subset of C is " & IsSubSet(Range("A1:A10"), Range("C1:C10"))
MsgBox "C is a subset of A is " &IsSubSet(Range("C1:C10"), Range("A1:A10"))
End Sub


Function CommUniqueValues(R1 As Range, r2 As Range) As Variant
Dim myVals As Variant
Dim C As Range

ReDim myVals(1 To 1)
myVals(1) = "Nothing Entered"
For Each C In R1
If Application.CountIf(Range(R1.Cells(1), C), C.Value) = 1 Then
If Not IsError(Application.Match(C.Value, r2, False)) Then
If myVals(1) = "Nothing Entered" Then
myVals(1) = C.Value
Else
ReDim Preserve myVals(1 To UBound(myVals) + 1)
myVals(UBound(myVals)) = C.Value
End If
End If
End If
Next C
CommUniqueValues = myVals
End Function

Function AllUniqueValues(R1 As Range, r2 As Range) As Variant
'This one requires the reference to Microsoft Scripting Runtime.
Dim Dict As Dictionary
Dim ItemCount As Integer
Dim myC As Range
Dim i As Integer

Set Dict = New Dictionary
With Dict
'set compare mode
.CompareMode = BinaryCompare

'add items from both ranges to the dictionary
For Each myC In R1
If Not .Exists(myC.Value) Then
.Add Key:=myC.Value, Item:=i
i = i + 1
End If
Next myC
For Each myC In r2
If Not .Exists(myC.Value) Then
.Add Key:=myC.Value, Item:=i
i = i + 1
End If
Next myC

AllUniqueValues = .Keys
End With
Set Dict = Nothing
End Function

Function IsSubSet(R1 As Range, r2 As Range) As Boolean
Dim myStr As String
Dim myVal As Integer

IsSubSet = False
myStr = "=SUMPRODUCT(ISERROR(MATCH(" & R1.Address & "," & r2.Address & ",FALSE))*1)"
myVal = Application.Evaluate(myStr)
If myVal = 0 Then IsSubSet = True
End Function

 

[jay dean]

Thanks, Bernie!...I will test your code and give you my feedback...I
really appreciate this.

Jay


*** Sent via Developersdex http://www.developersdex.com ***