Generate Venn diagrams with multiple data

Hi,

I am looking for the best way to create a venn diagram with multiple data thereby the data from several 'circles' would proportionately overlap. I have seen an example on Chandoo that did this with vba but only for two circles. Does anyone know of any good examples? I've read that bubble charts may be also used but haven't seen any examples.

Thanks.

abousetta

Hi abousetta,

I googled this

Thanks @xladept. The program looks interesting but even their venn chart seems not to scale. Most people don't care about the scale but the project I am working needs it to be to scale. I have made some progress, but I still can't make it work just right. So I'm think my calculations might be off. If anyone can lend me a hand (especially if they are good with math and geometry) then I would be grateful.

My thoughts are that if I know the size of the three sides to triangle then I should be able to put the center of each 'bubble' on the correct x and y axis points. Any thoughts???

Anyways, attached is the current copy I am working on. Hopefully someone here has some insight into my dilemma.

abousetta

Hi Abousetta,

I usually make my own shapes - run this with The Venn Diagram data in A1:E6 - it's unpolished but allows for a scale (variable s):

Sub VennEm(): Dim s As Integer, i As Long, j As Long, Origin As Range
Dim R As Single, X As Single, Y As Single, OL As Single, OT As Single
Dim L As Single, T As Single, W As Single, H As Single

Set Origin = Range("J14"): OL = Origin.Left: OT = Origin.Top: s = 5

For i = 3 To 6
R = CSng(Range("C" & i) / s): X = CSng(Range("D" & i) / s): Y = CSng(Range("E" & i) / s)
L = OL + X / 2 - R / 2: T = OT - Y / 2 - R / 2: W = R: H = R

Dim O As MsoShapeType
Dim ws As Worksheet: Set ws = ActiveSheet: O = msoShapeOval
ws.Shapes.AddShape(O, L, T, W, H).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Transparency = 0.73

Next i
End Sub

I'm thinking about how to calculate the offsets - are the Areas and Intersections golden?

Thanks for this @xladept. I looks good.

abousetta

Thanks abousetta - but it's not correct - I'm thinking about it, but it's complex - at least doing your own shapes allows you to get it on the page

It's more complex than I imagined. So wonder you always see these things as using only two (if to scale) because the first starts at x = 0, y = 0 and the second will x = something and y = 0. The x for the second will depend on the overlap. Once you try to do the third, forth, etc. the math is just above my head. Even so, it has given me some options to work with.

Hi Abousetta,

I'm making some headway - I figured that there would be just one offset between any two circles, and the way to nail it would be in the combinations - so here's a way to get the offsets:

Sub TestGO()
Call GetOff(1585, 927, 2031733) 'V1,V2=1298
Call GetOff(1585, 170, 40063)   'V1,V3=1578
Call GetOff(1585, 87, 12113)    'V1,V4=1583
Call GetOff(927, 170, 13359)    'V2,V3=913
Call GetOff(927, 87, 4790)      'V2,V4=923
Call GetOff(170, 87, 12113)     'V3,V4=147
End Sub

Function GetOff(R1 As Single, R2 As Single, A As Single) As Single
Dim WF As WorksheetFunction, T As Single, Pi As Single, X As Single
Set WF = WorksheetFunction: Pi = WF.Pi
For T = 0.01 To 2 * Pi Step 0.02
If Abs(R1 / R2 * Sin(T)) > 1 Then
GoTo GetNext: End If
X = (R1 ^ 2 * (T - Sin(T)) + R2 ^ 2 * WF.Asin(R1 / R2 * Sin(T)) - R1 * R2 * Sin(T))
If X >= 2 * A Then
Exit For: End If
GetNext: Next T
GetOff = Sqr(R1 ^ 2 * (1 - Sin(T) ^ 2) + Sqr(R2 ^ 2 - R1 ^ 2 * Sin(T) ^ 2))
End Function

Sub VennEm(): Dim s As Integer, i As Long, j As Long, Origin As Range
Dim R As Single, X As Single, Y As Single, OL As Single, OT As Single
Dim L As Single, T As Single, W As Single, H As Single

Set Origin = Range("J14"): OL = Origin.Left: OT = Origin.Top: s = 10

For i = 3 To 6
R = CSng(Range("C" & i) / s): X = CSng(Range("D" & i) / s): Y = CSng(Range("E" & i) / s)
L = OL + X - R: T = OT - Y - R: W = 2 * R: H = 2 * R

Call VC(L, T, W, H)

Next i
End Sub
Sub VC(L As Single, T As Single, W As Single, H As Single):

Dim O As MsoShapeType
Dim ws As Worksheet: Set ws = ActiveSheet: O = msoShapeOval

ws.Shapes.AddShape(O, L, T, W, H).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Transparency = 0.73

End Sub

It's getting more correct This is almost what it should look like:Abousetta1.jpg

Hi Abousetta,

I removed all the glaring errors but I keep getting V4->V3 - but I was able to get 5/6 Intersections

anyway - here it is without some of the niceties but not devoid of any enhancements

Venn.xlsm

Hi,

This is really great. I think it's probably because the area of the forth circle is so small that accuracy is difficult. Let me try it with bigger values and see how the presentation looks. In all cases, I am happy with the results. Thank you so much for all your time and effort.

abousetta

P.S. You should add a thread in the tips and tutorials so that other will easily find your great example.

You're welcome! I haven't any experience with tips & tutorials but I'll check it out - thank you

Hi yogesh,

Welcome to the Forum!

I suspect that the 5/6 is a hard constraint - but I don't quite know how to prove it

The program deals only with circles while Venn diagrams could be elliptical - an elliptical configuration would be solvable, but I don't know how to write that

Hi Yogesh,

Here's the code - once you have the calculations, just run it from 3 to 5!

Sub VennEm(): Dim s As Integer, i As Long, j As Long, Origin As Range
Dim R As Single, X As Single, Y As Single, OL As Single, OT As Single
Dim L As Single, T As Single, W As Single, H As Single

Set Origin = Range("K17"): OL = Origin.Left: OT = Origin.Top: s = 10

For i = 3 To 5
R = CSng(Range("C" & i) / s): X = CSng(Range("H" & i) / s): Y = CSng(Range("I" & i) / s)
L = OL + X - R: T = OT - Y - R: W = 2 * R: H = 2 * R

Call VC(L, T, W, H)

Next i
End Sub

*the rest of the system is in the workbook post #9