Searching with recursion

[JKwan]

This is just driving me nuts and turn my head inside out. I am trying to do some recursion (:banghead::banghead::banghead:) with searching (I think this is what I need....). What I need is trying to find a chain of connections. With the attached file, I need to start with "From LSD" and "To LSD". Use the "To LSD" and search the "From LSD" and see where that match is. Then for every match do the same searches until there is no more matches or they are equal. When they matched, I wanted the "Asset Number" to be unioned with all the matched ones.

Example:
row 2 - "To LSD" = 05-08-043-01 W4 wanted to match all "From LSD", result below:
1103743 -- 05-08-043-01 W4 -- 08-07-043-01 W4
1104288 -- 05-08-043-01 W4 -- 03-17-043-01 W4
5708836 -- 05-08-043-01 W4 -- 06-08-043-01 W4
5710469 -- 05-08-043-01 W4 -- 05-08-043-01 W4 <---- this would be a "dead end" From and To are the same
1103815 -- 05-08-043-01 W4 -- 06-08-043-01 W4
1103819 -- 05-08-043-01 W4 -- 05-08-043-01 W4
1103775 -- 05-08-043-01 W4 -- 02-07-043-01 W4
1103785 -- 05-08-043-01 W4 -- 12-08-043-01 W4
1104325 -- 05-08-043-01 W4 -- 03-17-043-01 W4
1104362 -- 05-08-043-01 W4 -- 08-07-043-01 W4



I would like all those asset numbers to be captured (maybe concatenate and put into Column D) and then do it all over again using the above list until the above list is done (recursion, would be the best??). Now, do row 3, do the same thing over and over....

PS - I am just thinking out loud here, I don't know if I want to do this for the entire sheet or just a active cell..... I will take any suggestion

[SamT]

What's an LSD?
Why wwere' all the ones below the words "are the same" in your post "Captured"?
I assume the 7 digit number with no dashes is the asset number. What do you mean you want them "Unioned?"

I will take any suggestion
I suggest you start with a sheet with the raw data on it, then add a sheet with what you want for results.

Just manually produce 3 "Recursions, so we can see what you want to accomplish.

[JKwan]

LSD is a location format with Oil and Gas sector
I use dashes for visibility
Union - I would like to capture all the Asset Numbers for every match




Asset Number

From LSD

To LSD




1103787

06-08-043-01 W4

05-08-043-01 W4

1103743,1104288,5708836,5710469,1103815,1103819,1103775,1103785,1104325,110 4362



1103743

05-08-043-01 W4

08-07-043-01 W4

1103765,1103774,1103778,1103809,1104369



1103736

07-07-043-01 W4

03-07-043-01 W4

1103713,1103725,1103770,1103777,1103799,1103804,1103790,1103805,1102922



1103765

08-07-043-01 W4

07-07-043-01 W4

1103736,1103739,1103760,1103780,1103784,1103789,1103794,1104616




Yes, I know this may turn out to be a spider web.... I am doing this as a test and see where it will take me.
The chain will stop when the From = To or that the list is exhausted.

[offthelip]

One quite easy way to solve this would be to make two copies of the three columns in another worksheet then sort the first set on From LSD and thje second set on To LSD, then finding the common bits between them is quite easy.

[offthelip]

I found time to try out my method , see if this does what you want:


Sub movsort()
Dim sht As Worksheet


With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(.Cells(1, 1), .Cells(lastrow, 3))
Range(.Cells(1, 4), .Cells(lastrow, 4)) = ""
outarr = Range(.Cells(1, 4), .Cells(lastrow, 4))

End With
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "TempSheet"
Range(Cells(1, 1), Cells(lastrow, 3)) = inarr
Range(Cells(lastrow + 1, 1), Cells((2 * lastrow), 3)) = inarr
temp3 = Range(Cells(1, 3), Cells(lastrow, 3))
Range(Cells(lastrow + 1, 2), Cells((2 * lastrow), 2)) = temp3
Set myrange = Range(Cells(1, 1), Cells((2 * lastrow), 3))
Set Sortkey = Range(Cells(1, 2), Cells((2 * lastrow), 2))
myrange.Sort key1:=Sortkey, order1:=xlAscending, MatchCase:=False, Header:=xlYes
flsd = Range(Cells(1, 1), Cells((2 * lastrow), 3))
For i = 1 To lastrow
com = "'"
For j = 1 To (2 * lastrow)
If inarr(i, 2) = flsd(j, 2) Then
outarr(i, 1) = outarr(i, 1) & com & flsd(j, 1)
com = ","
End If
Next j
Next i




Application.DisplayAlerts = False
Set sht = Worksheets("Tempsheet")
sht.Delete
Application.DisplayAlerts = True


With Worksheets("Sheet1")
Range(.Cells(1, 4), .Cells(lastrow, 4)) = outarr

End With
End Sub

[JKwan]

offthelip:
Looks very interesting, I did an initial run looks promising! I will look at it in further detail. Really appreciate the big help. THANKS

[JKwan]

offthelip:
Looking at it closely, it is not what I wanted. Your code looks at matching every From LSD to To LSD only, that is not what I wanted. What I need is:
1 - take the From LSD match it to To LSD, once matched then note the Asset Number
2 - use that To LSD and match that to the From LSD (refer to post #3), this is a connection, a chain effect (From To, From To up to N connections)
3 - this is why I need recursion...
4 - this may be a spider web effect that I refer to and I don't know what that will do or work, this is why I am experimenting...
5 - this is why I am thinking that I need to do this with active cell not the entire sheet....

nonetheless, thank you for your time and help

[offthelip]

Hopefully I understand better now try this, it does do the recursive bit.


Dim str As String
Dim status As String
Dim inarr() As Variant
Dim lastrow As Integer
Dim outpt As String
Dim com As String










Sub findit()
Dim str As String


With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(.Cells(1, 1), .Cells(lastrow, 3))

Range(.Cells(1, 4), .Cells(lastrow, 4)) = ""
outarr = Range(.Cells(1, 4), .Cells(lastrow, 4))



outpt = ""
'For jj = 2 To lastrow
For jj = 2 To 20
str = inarr(jj, 2)
status = "Next"
com = "'"
Do While status = "Next"


Call findone(str, inarr, lastrow, status)
com = ","

Loop
outarr(jj, 1) = outpt
outpt = ""
Next jj

Range(.Cells(1, 4), .Cells(lastrow, 4)) = outarr
End With
End Sub


Sub findone(str As String, inarr() As Variant, lastrow As Integer, status As String)
fnd = False
For i = 2 To lastrow
If str = inarr(i, 2) Then
If str = inarr(i, 3) Then
' end of line

status = "Dead end"
fnd = True
outpt = outpt & com & inarr(i, 1)
Exit For
Else
str = inarr(i, 3)
status = "Next"
fnd = True
outpt = outpt & com & inarr(i, 1)
Exit For
End If
End If
Next i
If Not (fnd) Then
status = "Not found"
End If
End Sub

[JKwan]

Thanks again, I will take a closer look later on.

[JKwan]

I think this is what I need. The output looks really promising, however, I got an infinite loop when processing row 156 (below). I traced it, what I found is that it went back and found the FROM LSD again, how can I stop that???!!!

1102652
11-26-042-02 W4
10-26-042-02 W4

[SamT]

I sliced and diced both the table you have in the above post and the uploaded workbook , but I could not figure out the logic of your request.

It seems that your data is in random order. After some sorting, I was able to find all the Asset numbers you listed in the first post. But however I sorted, I could not get the results you show by stopping at the first matching From and To.

1103743,1104288,5708836,5710469,1103815,1103819,1103775,1103785,1104325,110 4362



1103743

05-08-043-01 W4
08-07-043-01 W4

1103775

05-08-043-01 W4
02-07-043-01 W4


1103775
05-08-043-01 W4
02-07-043-01 W4

1104288

05-08-043-01 W4
03-17-043-01 W4


1103785
05-08-043-01 W4

12-08-043-01 W4

1104325

05-08-043-01 W4
03-17-043-01 W4


1103815
05-08-043-01 W4
06-08-043-01 W4

1103819

05-08-043-01 W4

05-08-043-01 W4


1103819
05-08-043-01 W4

05-08-043-01 W4

5710469

05-08-043-01 W4

05-08-043-01 W4


1104288

05-08-043-01 W4
03-17-043-01 W4

1103815

05-08-043-01 W4
06-08-043-01 W4


1104325

05-08-043-01 W4
03-17-043-01 W4

5708836

05-08-043-01 W4
06-08-043-01 W4


1104362
05-08-043-01 W4
08-07-043-01 W4

1103743

05-08-043-01 W4
08-07-043-01 W4


5708836
05-08-043-01 W4
06-08-043-01 W4

1104362

05-08-043-01 W4
08-07-043-01 W4


5710469
05-08-043-01 W4

05-08-043-01 W4

1103785

05-08-043-01 W4
12-08-043-01 W4




The Left Hand table is sorted by From then Asset.The Right hand is sorted by From then To.
The Bold Cells are the matching From LSD and To LSD.

Where's the logic?

[offthelip]

A very small modification to get out of the infinite loop,: two lines added (see comments) the idea of this is when it detects a matching row it blanks the data in the input array so that it can't find it again. This means that I need to reload the input array after each loop




Dim str As String
Dim status As String
Dim inarr() As Variant
Dim lastrow As Integer
Dim outpt As String
Dim com As String










Sub findit()
Dim str As String


With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(.Cells(1, 1), .Cells(lastrow, 3))

Range(.Cells(1, 4), .Cells(lastrow, 4)) = ""
outarr = Range(.Cells(1, 4), .Cells(lastrow, 4))



outpt = ""
'For jj = 2 To lastrow
For jj = 2 To 160
inarr = Range(.Cells(1, 1), .Cells(lastrow, 3)) ' line added
str = inarr(jj, 2)
status = "Next"
com = "'"
Do While status = "Next"


Call findone(str, inarr, lastrow, status)
com = ","

Loop
outarr(jj, 1) = outpt
outpt = ""
Next jj

Range(.Cells(1, 4), .Cells(lastrow, 4)) = outarr
End With
End Sub


Sub findone(str As String, inarr() As Variant, lastrow As Integer, status As String)
fnd = False
For i = 2 To lastrow
If str = inarr(i, 2) Then
inarr(i, 2) = "" ' line added
If str = inarr(i, 3) Then
' end of line

status = "Dead end"
fnd = True
outpt = outpt & com & inarr(i, 1)
Exit For
Else
str = inarr(i, 3)
status = "Next"
fnd = True
outpt = outpt & com & inarr(i, 1)
Exit For
End If
End If
Next i
If Not (fnd) Then
status = "Not found"
End If
End Sub

[JKwan]

@offthelip - A big thanks, endless loop no more, I was able to process the entire sheet. I now need to check the connections and apply more logic to see if they actually connect to each other. The heavy lifting is done.
@Sam - A simple logic was that I start using the TO and then use it match the FROM, then do it all over again. I thank you for your time looking into it. I think offthelip's solution is what I am after. I just need to do more checking.

[SamT]

:thumb