Looking for VBA algorithm for circular references

[Paul_Hossler]

As part of a large VBA application I have a list arranged in a parents-child fashion

Does anyone have an algorithm that 'walks' the list to identify children who are their own great-great-great-grandparent?

In the screen shot, the parent-child relationships in rows 2 - 17 are non-circular, since no one is their own grandfather

Adding row 18 data, makes the list circular since

DDD is the parent of KKK
KKK is the parent of NNN
NNN is the parent of DDD

The actual application could be 20 or 30 'generations' deep.

Appreciate any thoughts

Paul

[shrivallabha]

Hi Paul,

I think, treeview control could be an option. Have you considered using it?

If you are interested in using it then you may use this link where it has been explained nicely: Ken Puls (http://www.excelguru.ca/content.php?194-Using-a-Treeview-Control)

[mikerickson]

I notice that DDD has two parents. That can be detected more easily than a loop.

"Some descendent of X has two or more parents" is a necessary, but not sufficient, condition for "X is involved in a circular reference"

Do you have any "Y" type branching like

Adam Bob
Bob Carl
Carl DDDD
alice betty
betty carol
carol DDDD
DDDD EEEE
EEEE FFFF
etc.

DDDD has two parents, but no circularity.

[snb]

Based on your example (I would have appreciated an Excel attachment):


Sub snb()
sn = Cells(1).CurrentRegion

For j = 1 To UBound(sn)
If j = 1 Then
c01 = sn(j, 1) & "|" & sn(j, 2)
ElseIf j = 2 Then
c02 = sn(j, 1) & "|" & sn(j, 2)
ElseIf j = 3 Then
c03 = sn(j, 1) & "|" & sn(j, 2)
Else
c04 = sn(j, 1) & "|" & sn(j, 2)
If InStr("|" & c01 & "|", "|" & sn(j, 2) & "|") Then c05 = "c01 circular item " & sn(j, 2)
If InStr("|" & c02 & "|", "|" & sn(j, 2) & "|") Then c05 = "c02 circular item " & sn(j, 2)
If InStr("|" & c03 & "|", "|" & sn(j, 2) & "|") Then c05 = "c03 circular item " & sn(j, 2)
If c05 <> "" Then Exit For
c01 = Replace(c01, sn(j, 1), c04)
c02 = Replace(c02, sn(j, 1), c04)
c03 = Replace(c03, sn(j, 1), c04)
End If
Next

If c05 <> "" Then MsgBox c05
End Sub

[Paul_Hossler]

Hi Paul,

I think, treeview control could be an option. Have you considered using it?



Actually, i had thought about it but I'm really trying to get the algorithm working since it will be part of another project.

Also, I think TreeView is one of those controls that is not 64 bit Office compatible, which is where the company is going

Paul

[shrivallabha]

I guess, if we are thinking in terms of one time shoot and forget code then maybe algorithm can be developed. As with plain algorithm, it might become too much of headache to edit a code should a need arise.

But if we are looking at long term scenario and maintenance then perhaps using Classes might be more prudent choice. Even for the first scenario, classes might prove better.

[Paul_Hossler]

Good questions -- helped to refine my thoughts some more. Hopefully if I can explain and re-phrase I'll continue to get good ideas and suggetions.

(snb -- I'll attach a wb, promise :thumb )

In context of manufacturing something using these rules --

Parents are assemby items made up of sub-assemblies (also a parent) and/or buy parts (no children) (both considered children of the Parent)

Children have a Parent, but might not have any children of their own (i.e. a Buy part) or they might have their own Children (i.e. a sub-assembly)

To make 1 AAA, I need

1 BBB (has children)
2 CC (has children)
1 DDD (has children)

To make the 1 BBB that I need to make the AAA, I need to buy

1 EEE (has no children)
1 FFF (has no children)
1 GGG (has no children)

etc.

When all is said and done and if there are no circular references, I'll end up with a list of the buy parts.

If there is a circular reference (by throwing row 20 into the mix), then I'll end up in a situation where

To make AAA I need DDD
To make DDD I need KKK
To make KKK I need NNN
BUT to make the NNN, I need DDD

And to make DDD I need KKK
To make KKK I need NNN
BUT to make the NNN, I need DDD ....... etc

I was looking for a algorithm that would 'walk' the relationships to see if that situation would arise

Thanks

Paul

[Paul_Hossler]

Workbook as promised

Paul

[mikerickson]

Consider the attached UDF

CircularChilderen(gMotherName, dataRange, fullPath, outDelimiter)
will return either:

1) The first chain involving circularity that flows from gMotherName
or, if no such chain exits
2) The longest chain of descendants that flows from gMotherName

(optional FullPath and outDelimiter default to True, " > ")

With this data set
Ann Bob
Ann Betty
Bob Carl
Bob Carol
Betty Xavier
Carl Dave
Carol Denise
Dave Bob
Denise Edward

=CircularChildren("Carol", A1:A10) returns "Carol > Denise > Edward" (no circularity)
=CircularChildren("Bob", A1:A10) returns "Bob > Carl > Dave > Bob"
=CircularChildren("Ann", A1:A10) returns "Ann > Bob > Carl > Dave > Bob"

When used as a UDF in a spreadsheet, it slows things way, way down.
But the logic could be used for other routines.

Given a person, e.g. "Ann"
Given an array of mothers and an array of their children.
{Ann, Ann, Bob, Bob, Betty, Carl, Dave, Denise}
{Bob, Betty, Carl, Carol, Xavier, Dave, Denise, Bob, Edward}

Devise a function, DaughtersOf, that returns the children of a given mother.
e.g. DaughersOf("Ann") = {Bob, Betty}


pseudo-code

Create an array, Descendents, initialy containing only the person of interest {Ann}
inPointer = 1, outPointer = 1

Begin Loop

Get DaughtersOf(last person in Descendents(inPointer))

For Each oneDaugher in DaughersOf(...)
If oneDaughter in the string Descendents(inpointer) Then
there is circularity. Exit all of the loops and output.
Else
' add Descendents(inpointer) & oneDaughter to Descendants
outPointer+1
Descendents(outpointer) = Descendents(inpointer) & oneDaughter
End If
Next oneDaughter

inPointer = inPointer+1
Loop until outPointer < inPointer

Descendents is a list of all the chains flowing from Ann
As we go through the outer loop, Descendants gets bigger (color indicates the chains that have already been examined)

{Ann}
DaughtersOf("Ann") = {Bob, Betty}

{Ann, Ann>Bob, Ann>Betty}
DaughtersOf("Bob") = {Carl, Carol}

{Ann, Ann>Bob, Ann>Betty, Ann>Bob>Carl, Ann>Bob>Carol}
DaughtersOf("Betty") = {Xavier}

{Ann, Ann>Bob, Ann>Betty, Ann>Bob>Carl, Ann>Bob>Carol, Ann>Betty>Xavier}
DaughtersOf("Carl") = {Dave}

{Ann, Ann>Bob, Ann>Betty, Ann>Bob>Carl, Ann>Bob>Carol, Ann>Betty>Xavier, Ann>Bob>Carl>Dave}
DaughtersOf("Carol") = {Xavier}

{Ann, Ann>Bob, Ann>Betty, Ann>Bob>Carl, Ann>Bob>Carol, Ann>Betty>Xavier, Ann>Bob>Carl>Dave, Ann>Bob>Carol>Denise}
DaughtersOf("Xavier") = {""}

{Ann, Ann>Bob, Ann>Betty, Ann>Bob>Carl, Ann>Bob>Carol, Ann>Betty>Xavier, Ann>Bob>Carl>Dave, Ann>Bob>Carol>Denise}
DaughersOf("Dave")={"Bob"}

"Bob" is in "Ann>Bob>Carl>Dave", therefore circularity.

As I said, as a worksheet (conditional formatting, validation) UDF, this is a lousy solution.
(My DaughtersOf can defiantly be improved)
But the logic can be adapted.

[Paul_Hossler]

Mike -- fantastic :beerchug:

I'll have to go through the logic to understand it (and learn), but just reading your post is a help.

Thanks a lot

Paul

[snb]

@Paul

Did you run the code I suggested ?
As far as I can see it produces exactly the result you are looking for.

[Paul_Hossler]

Did you run the code I suggested ?


Actually, I haven't had a chance to do more that eyeball both your's and Mike's

Based on comments, I spent the time trying to explain better and make a better example. "Ask a better question, get a better answer"

Since the actual application can have 50k - 100K+ lines and might be 30 or 40 levels deep, preformance will be an issue, so between the two answers I'm sure that I'll be able to get there

Thanks again to both

Edit: I did try your code (thanks again), but I forgot to say in the original that a lower level 'child' could possibly have multiple parents.

It's only the situation that a child that must be it's own grand^n-parent that I'm trying to catch. Using the attached WB with your macro, it seems like my 'forgot to mention it' reqirement generates false positives "Circular req EEE" because EEE is used multiple times. EEE requires BBB which requires AAA. If AAA had required EEE than that would be the situation I'm trying to catch : AAA --> BBB --> EEE --> AAA --> BBB --> etc. since in this case AAA (#2) must be it's own grandparent AAA(#1)

Something like AAA --> SSS --> EEE <done> and BBB --> TTT --> EEE <done> is OK since although EEE is used multiple times, in neither instance is it it's own ancester

Am I understanding that part correctly?

Paul

[mikerickson]

Re: code in post #4.

This data set returned "no circle" in my testing


parent child
Able Baker
Baker Charlie
One Two
Two Three
Three One
Charlie David
a b
b c
c d
d e
David Able

[Paul_Hossler]

Probably because my requirements were less than perfect. I changed the input test data after I got the first responses when I realized that I had several unstated assumptions that weren't included in the initial question.

Paul

[snb]

I hope this will do the trick

Sub snb()
sn = ActiveSheet.Cells(1, 1).CurrentRegion.Value
c01 = "~" & Join(Application.Transpose(ActiveSheet.Cells(1, 1).CurrentRegion.Columns(1).Value), "~|~")

For j = 1 To UBound(sn) ' remove items with children that do not act as parent too
If InStr(c01, "~" & sn(j, 2) & "~") Then c02 = c02 & vbCr & sn(j, 1) & "|" & sn(j, 2)
Next
c02 = Mid(c02, 2)

Do
c03 = Len(c02)
sn = Split(c02, vbCr)
For j = 0 To UBound(sn) ' construct the concatenation strings
c02 = Replace(c02, Split(sn(j), "|")(0) & vbCr, sn(j) & vbCr)
Next

sn = Split(c02, vbCr)
For j = 0 To UBound(sn) ' test each string for circular references
st = Split(sn(j), "|")
If UBound(st) > 1 Then
For jj = 0 To UBound(st)
If UBound(Filter(st, st(jj))) > 0 Then
MsgBox "circular reference in " & sn(j) & " item " & st(jj)
Exit Sub
End If
Next
End If
Next
Loop Until Len(c02) = c03
End Sub

[Paul_Hossler]

You and Mike are my new Excel heros

Both of you -- that was some pretty nifty coding

snb -- Never knew about Filter (). That will come in handy

Now all I have to do is

1. Understand it
2. Incorporate it into the overall application

But you both did the hard work

Thanks again

Paul

[snb]

Some slight improvements:

Sub snb()
sn = Sheets("Test").Cells(1).CurrentRegion
c01 = "~" & Join(Application.Transpose(Application.Index(sn, , 1)), "~|~") & "~"

For j = 1 To UBound(sn) ' remove items with children that do not act as parent too
If InStr(c01, "~" & sn(j, 2) & "~") Then c02 = c02 & vbCr & sn(j, 1) & "|" & sn(j, 2)
Next
c02 = Mid(c02, 2)
sn = Split(c02, vbCr)

Do
c03 = Len(c02)
For j = 0 To UBound(sn) ' construct the concatenation strings
c02 = Replace(c02, Split(sn(j), "|")(0) & vbCr, sn(j) & vbCr)
Next

sn = Split(c02, vbCr)
For j = 0 To UBound(sn) ' test each string for circular references
st = Split(sn(j), "|")
If UBound(st) > 1 Then
For jj = 0 To UBound(st)
If UBound(Filter(st, st(jj))) > 0 Then
MsgBox "circular reference in " & sn(j) & " item " & st(jj)
Exit Sub
End If
Next
End If
Next
Loop Until Len(c02) = c03
End Sub