[corrects incomplete post]
"Bill Renaud" wrote:

Here is a revised version of the code posted by "Dave D-C" that solves the
problem of endless recursion, if the connections happen to loop back around
on themselves.

Option Explicit

'Code by "Dave D-C".

'Revisions (by Bill Renaud):
'1. Add ActiveSheet qualifier to Main routine.
'2. Declare each connection to be variant type,
' in case they are not numbers.
'3. Add error handler to prevent attempts to add the
' same connection to the collection more than once.
'4. Prevent endless recursion by checking to see if
' the group number has already been entered on a row.

Dim gColl As New Collection, gRng As Range, gRowZ&

Public Sub Main2()
Dim iRowV&, nGroup%
Set gRng = ActiveSheet.UsedRange ' original usedrange
' get last row
gRowZ = gRng.SpecialCells(xlCellTypeLastCell).Row
iRowV = 1
Do While iRowV <= gRowZ ' look for group start
If Cells(iRowV, 3) = "" Then
nGroup = nGroup + 1 ' is a start
Call Group1st(nGroup, iRowV)
End If
iRowV = iRowV + 1
Loop
End Sub

Private Sub Group1st(pGroup%, pRow&)
Dim iRow&
' start on row 1
Call GroupNth(pGroup, Cells(pRow, 1))
Call GroupNth(pGroup, Cells(pRow, 2))
' done, list the group items at the end
iRow = gRowZ + pGroup + 1
Cells(iRow, 1) = pGroup ' Group#
Do While gColl.Count 0 ' get items
Cells(iRow, gColl.Count + 2).Value = gColl(gColl.Count)
gColl.Remove gColl.Count ' and remove
Loop
End Sub

Private Sub GroupNth(pGroup%, Cell1 As Range)
Dim v1 As Variant
Dim CellN As Range
On Error Resume Next
Cells(Cell1.Row, 3) = pGroup ' group#
v1 = Cell1.Value
gColl.Add v1, Format(v1) ' add item 1
' 1st find
Set CellN = gRng.Find(v1, Cell1, xlValues, xlWhole, xlByRows, xlNext)
Do While CellN.Address < Cell1.Address
'Do next find recursively. Skip if Group number has
'already been filled in (row has already been processed).
If IsEmpty(Cells(CellN.Row, 3)) _
Then
Call GroupNth(pGroup, Cells(CellN.Row, 3 - CellN.Column))
End If
' can't do findnext with recursion
Set CellN = gRng.Find(v1, CellN, xlValues, xlWhole, xlByRows, xlNext)
Loop
End Sub


----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----
http://www.newsfeeds.com The #1 Newsgroup Service in the World! 120,000+ Newsgroups
----= East and West-Coast Server Farms - Total Privacy via Encryption =----