Inter related items

[theta]

Hi,

Having a real headache with this. Trying to find all inter-related items. Thinking of doing lookups into an array. Then performing a lookup on the result...until the script returns a blank or error...

This is the type of data I will be using :

ID1.......ID2.......ID3..........ID4
====================================
101.......208.......356.............
101.......208.......357.............
101.......208.......357.............
102.......208.......357..........703
103.......208.......357..........703
104..............................703

So....101 is related directly to 208,356,357...which means it is related to 703 by 357. It is also therefore related to 104 by 703.

I would like a reference appended in each row, which would be a concatenation of all related (directly and indirectly) items

e.g. 101 = 102,103,104,356,357,703

Although it is only related directly to 208,356,357, it is overall related to the others

Any help greatly appreciated

Regards

Luke

[Bob Phillips]

AN example of some related some non-rewalted would help (this example all seem related), and your expected results

[theta]

There is an example. 703 is not directly related to 101...but is indirectly related through joint references....

[SamT]

Q1) Is that an example of four columns and seven rows in an Excel range?

Q2) What does a Range that has two groups of relationships, where the data in one group is not related to the data in the other group look like.

Q3) How many rows and columns in the Range.

[theta]

1) Yes it is

2) Data where there are relationships look as follows :

ID1.......ID2.......ID3..........ID4
====================================
101.......208.......356.............
101.......208.......357.............
101.......208.......357.............
102.......208.......357..........701
103..............................701
104.................................

103 related to 701, which relates to 102,208,357 which relates to 101,356.

104 is not related to anything.

3) We are looking at max 7 columns...but rows could be 100,000. But once relationships have been found, can lookup the concatenated reference for each row, as each row will form part of it for the cells above (assuming its related)

[SamT]

PseudoCode only:
[vba]
Assuming "ID1" is in Cell A1
CurrentRow = 2
StartOver:
StartOfRange = Cells(CurrentRow, 1)
EndOfRange = Cells(Row(Last instance of StartofRange.Value), 7)
StartValue = StartOfRange.Value
NextRow = EndOfRange.Row + 1
DirectArray = FindUnique(Range(StartofRange &":"& EndofRange)
'That will find all direct relations to 101

While CurrentRow < UsedRows.Count + 1 'If NextRow > UsedRows, Process will fall out the Wend
SearchedToIndex = UBound(DirectArray)

FindMore:
Found = False
For i = SearchedToIndex to UBound(DirectArray)
IndirectArray = Find What:= DirectArray(i) FindIn:= Range("A2: & Cells(UsedRows.Count, 7) &")"
Next i
IndirectArray = Unique(IndirectArray)
IndirectArray = IndirectArray - DirectArray 'Pull out all Values already found
If Not IsEmpty(IndirectArray) Then Found = True 'We found a new value
DirectArray = DirectArray + IndirectArray 'Add new unique values to DirectArray
IndirectArray = Empty 'Clear it out for the next round
If Found Then 'We're not done with this DirectArray yet
Go To FindMore
Else 'Write the result and start over with the next value in column A
Cells(CurrentRow,8)).Value = DirectArray(All Values)
Empty DirectArray
CurrentRow = NextRow
Go To StartOver
End If
Wend
End Sub
[/vba]

[theta]

Hi, sorry not been on here for a while. Will test the code and get back asap

Thanks

Luke

[theta]

Giving me errors as follows :

[VBA]'Assuming "ID1" Is In Cell A1
CurrentRow = 2
StartOver:
StartofRange = Cells(CurrentRow, 1)
EndOfRange = Cells(Row(Last instance of StartofRange.Value), 7)
StartValue = StartofRange.Value
NextRow = EndOfRange.Row + 1
DirectArray = FindUnique(Range(StartofRange &":"& EndofRange)
'That will find all direct relations to 101

While CurrentRow < UsedRows.Count + 1 'If NextRow > UsedRows, Process will fall out the Wend
SearchedToIndex = UBound(DirectArray)

FindMore:
Found = False
For i = SearchedToIndex To UBound(DirectArray)
IndirectArray = Find What:= DirectArray(i) FindIn:= Range("A2: & Cells(UsedRows.Count, 7) &")"
Next i
IndirectArray = Unique(IndirectArray)
IndirectArray = IndirectArray - DirectArray 'Pull out all Values already found
If Not IsEmpty(IndirectArray) Then Found = True 'We found a new value
DirectArray = DirectArray + IndirectArray 'Add new unique values to DirectArray
IndirectArray = Empty 'Clear it out for the next round
If Found Then 'We're not done with this DirectArray yet
GoTo FindMore
Else 'Write the result and start over with the next value in column A
Cells(CurrentRow,8)).Value = DirectArray(All Values)
Empty DirectArray
CurrentRow = NextRow
GoTo StartOver
End If
Wend
End Sub[/VBA]

Please help!