View Full Version : [SOLVED:] Searching with recursion
JKwan
08-22-2017, 11:02 AM
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
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
08-22-2017, 12:34 PM
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
08-22-2017, 12:50 PM
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
08-22-2017, 03:56 PM
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
08-23-2017, 06:24 AM
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
08-23-2017, 07:42 AM
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
08-23-2017, 08:32 AM
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
08-23-2017, 12:10 PM
Thanks again, I will take a closer look later on.
JKwan
08-23-2017, 01:02 PM
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
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
08-23-2017, 04:21 PM
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
08-24-2017, 07:34 AM
@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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.