Consulting

Results 1 to 14 of 14

Thread: Searching with recursion

  1. #1
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location

    Searching with recursion

    This is just driving me nuts and turn my head inside out. I am trying to do some recursion () 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
    Attached Files Attached Files

  2. #2
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  3. #3
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location
    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.
    Attached Files Attached Files

  4. #4
    VBAX Expert
    Joined
    May 2016
    Posts
    604
    Location
    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.

  5. #5
    VBAX Expert
    Joined
    May 2016
    Posts
    604
    Location
    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

  6. #6
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location
    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

  7. #7
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location
    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

  8. #8
    VBAX Expert
    Joined
    May 2016
    Posts
    604
    Location
    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

  9. #9
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location
    Thanks again, I will take a closer look later on.

  10. #10
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location
    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

  11. #11
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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?
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  12. #12
    VBAX Expert
    Joined
    May 2016
    Posts
    604
    Location
    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

  13. #13
    VBAX Expert
    Joined
    Aug 2004
    Posts
    810
    Location
    @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.

  14. #14
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •