Updating For Each loop variable

Question

enter image description here

The aim is to find the circularity between value in column c and all values obtained from updated "firstvalue" variable which are comma separated and stored in column "M".

Sub circular()
Dim rng As Range, rng2 As Range, firstvalue As String, secondvalue As String
Set sh = ThisWorkbook.Worksheets("Sheet1")
lr = sh.Range("C" & Rows.Count).End(xlUp).Row
For Each rng In sh.Range("C5:C" & lr) 'iterating over each cell in column "c" from C5 till lastrow "lr". 
        firstvalue = rng.Offset(0, 10).value 'Corresponding cell value which is comma seperated in column 
                                              "M" i:e after 10 columns from "C".    
        Dim n As Variant
        For Each n In Split(firstvalue, ",")   'Looping through each value obtained from split function.
        Set rng2 = sh.Range("C5:C" & lr).Find(Trim(n), LookIn:=xlValues)  'Finding that split value again 
                                                                          in column "C".
        If Not rng2 Is Nothing Then                                      'if exists in column c then get. 
        secondvalue = rng2.Offset(0, 10).value                           'corresponding cell values.    
        firstvalue = firstvalue & "," & secondvalue                      'now first value is concatnated 
                                                                          with initial firstvalue
        End If
        Next n                        
        MsgBox firstvalue
        'Now i want to itterate over updated "firstvalue" in split function and this goes on in circular 
         fashion until rng value exists in firstvalue. 
Next rng            'then change next rng and continue the above whole process for this value and so on.
End Sub

This code is working for initial firstvalue, can any one suggest any method to iterate over updated first value.

user_14094617 · Answer

I'm not sure if I understand your goal exactly, but this code should find all predecessors for each task:

Sub circular()
Dim sh As Worksheet
Dim rTask As Range
Dim oCell As Range
Dim oFound As Range
Dim lr As Long, j As Long
Dim aPredecessors As Variant
Dim sCurTask As String
Dim secondValue As String
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    lr = sh.Range("C" & Rows.Count).End(xlUp).Row
    Set rTask = sh.Range("C5:C" & lr)
    
    For Each oCell In rTask
        sCurTask = Trim(oCell.Text)
        aPredecessors = getPredecessors(Trim(oCell.Offset(0, 10).Text))
        j = LBound(aPredecessors)
        Do Until j > UBound(aPredecessors)
            secondValue = aPredecessors(j)
            If sCurTask = secondValue Then
                ReDim Preserve aPredecessors(j)
                Debug.Print "Task '" & sCurTask & "': Cyclic link '" & secondValue & "' for '" & Join(aPredecessors, ",") & "'!"
                aPredecessors(j) = aPredecessors(j) & " !!!"
            Else
                If secondValue <> vbNullString Then
                    Set oFound = rTask.Find(secondValue, LookIn:=xlValues)
                    If oFound Is Nothing Then
                        ReDim Preserve aPredecessors(j)
                        Debug.Print "Task '" & sCurTask & "': Task '" & secondValue & "' for '" & Join(aPredecessors, ",") & "' not found!"
                        aPredecessors(j) = aPredecessors(j) & " ???"
                    Else
                        Call addNewTasks(aPredecessors, Trim(oFound.Offset(0, 10).Text))
                    End If
                End If
            End If
            j = j + 1
        Loop
        oCell.Offset(0, 11).Value = Join(aPredecessors, ",")
    Next oCell
End Sub

Function getPredecessors(sPredecessors As String)
Dim i As Long
Dim aTemp As Variant, sRes As String
Dim sTest As String
    sRes = vbNullString
    aTemp = Split(sPredecessors, ",")
    For i = LBound(aTemp) To UBound(aTemp)
        sTest = Trim(aTemp(i))
        If InStr("," & sRes & ",", "," & sTest & ",") = 0 Then sRes = sRes & sTest & ","
    Next i
    If Len(sRes) > 1 Then sRes = Left(sRes, Len(sRes) - 1)
    getPredecessors = Split(sRes, ",")
End Function

Sub addNewTasks(aData As Variant, sPredecessors As String)
Dim i As Long, uB As Long
Dim aTemp As Variant
Dim sTest As String, sValid As String
    aTemp = Split(sPredecessors, ",")
    If UBound(aTemp) >= 0 Then ' Not empty
        sValid = "," & Join(aData, ",") & ","
        For i = LBound(aTemp) To UBound(aTemp)
            sTest = Trim(aTemp(i))
            If sTest <> vbNullString Then
                If InStr(sValid, "," & sTest & ",") = 0 Then
                    uB = UBound(aData) + 1
                    ReDim Preserve aData(uB)
                    aData(uB) = sTest
                    sValid = "," & Join(aData, ",") & ","
                End If
            End If
        Next i
    End If
End Sub

Updating For Each loop variable

1 Answers