Cannot get get While or Do loop to do the simple task required. End up with endless looping. I'm missing something basic.

[OaklandJim]

I cannot get myself out of an endless While or Do loop while attempting to help another MrExcel lister. Raw data is as follows. I loop data in this worksheet

ListTasks2.xlsm
	A
3	20
4	21
5	22
6	23
7	24
8	25
List

For each number in the data above I then look for the word "Task" to determine when to end the while or do loop when looping through the data below.

ListTasks2.xlsm
	A
3	Task 20
4	A
5	B
6	C
7	Task 22
8	E
9	Task 23
10	F
11	G
12	Task 24
13	B
14	C
15	Task 25
16	D
17	E
Tasks

Code is supposed to iterate through the data for each task number (shown in mini sheet List) then look in data in mini sheet Tasks and get the letters under the respective task. For example, if I send a cell object to the sub with the loop -- such as cell A3 for Task 20 -- code should report A, B, and C then exit the loop. I tried While and Do to no avail. Looping is endless rather than merely reporting the three values for Task 20 in A3.

I've tried different approaches and all result in an endless loop as the condition sought to end the loop is not found.

Sub ListToTasks()

    Dim wsList As Worksheet
    Dim wsTasks As Worksheet
    
    Dim rAnchorCellList As Range
    Dim rAnchorCellTasks As Range
    
    Dim rListCells As Range
    Dim rListCell As Range
    
    Dim rTasksCell As Range
    
    Dim iColumns As Long
    Dim iRows As Long
    
    Set wsList = ThisWorkbook.Worksheets("List")
    Set wsTasks = ThisWorkbook.Worksheets("Tasks")
    
    Set rAnchorCellList = wsList.Range("A3")
    Set rAnchorCellTasks = wsTasks.Range("A3")
    
'   Need to clear existing results.
    With rAnchorCellList.CurrentRegion
        iColumns = .Columns.Count
        iRows = .Rows.Count
    End With
    
    rAnchorCellList.Offset(, 1).Resize(iRows, iColumns - 1).Clear
    
'   Set range object to point to the one column range of task numbers in worksheet List.
    Set rListCells = rAnchorCellList.Resize(iRows, 1)
    
'   Iterate each number in the List worksheet.
    For Each rListCell In rListCells
        
'       Locates the string "Task " & rListCell.Value in the Task worksheet.
'       rTasksCell is a ByRef parameter that is set to the cell where the string is found.
        Call FindStringInSheet(wsTasks, "Task " & rListCell.Value, rTasksCell)
        
        If Not rTasksCell Is Nothing _
         Then
         
            Call GetTaskList(rTasksCell)

        End If
    Next
    
End Sub


Sub GetTaskList(ByVal prTasksCell As Range)

    Dim sTaskAlpha As String
    
    Dim iOffset As Long
    
    Dim bDone As Boolean
    
    sTaskAlpha = ""
    
    bDone = False
    
Debug.Print "prTasksCell  = " & prTasksCell.Address
    
'    Do
'        iOffset = iOffset + 1
'        sTaskAlpha = prTasksCell.Offset(iOffset)

'Debug.Print "sTaskAlpha = " & sTaskAlpha

'        If sTaskAlpha Like "Task*" Then bDone = True
'
'    Loop While bDone = False
'
    
'    While Not sTaskAlpha Like "Task*"
'
'        iOffset = iOffset + 1
'        sTaskAlpha = rTasksCell.Offset(iOffset)
'
'Debug.Print "sTaskAlpha = " & sTaskAlpha
'
'    Wend

End Sub

The debug.print in the second (looping) sub reports the correct cells:

prTasksCell = $A$3
prTasksCell = $A$7
prTasksCell = $A$9
prTasksCell = $A$12
prTasksCell = $A$15

 

[Anthony47]

If you need the result into the worksheet cells then set in List!B3, near the firs task number, the following formula

=LET(TaskN,A3,tArr,Tasks!$A$3:$A$20,fStr,TEXTJOIN(";",TRUE,IF(LEFT(tArr,7)="Task "&TaskN,"#",IF(LEFT(tArr,4)="Task","*",IF(tArr<>"",tArr,""))))&"*",farr,TEXTSPLIT(TEXTBEFORE(TEXTAFTER(fStr,"#"),"*"),";",,TRUE),farr)

Copy then down

Requires Office 365

 

[OaklandJim]

Thank you for the response but I need to do this with code as there is additional processing needed after I get those letters for a specific task. So I still need assistance with a while or do loop.

 

[Alex Blakenburg]

I can't run your code because you have not provided your subroutine FindStringInSheet
One issue might be that it is not looping through to the next find or not ending when it loops back to the find the first value again.

For the loop issue you are only exiting when you find the next occurence of Task. Assuming all rows are populated add a test for hitting the end being a blank cell. eg

If sTaskAlpha Like "Task*" Or sTaskAlpha = "" Then bDone = True

PS: I don't use While / Wend since that is superceded syntax and is there for backward compatibility.

 

[Anthony47]

In case that Alex's message doesn't clarify the situation, you might use the following function:

Function GetTasks(ByVal TaskN As Long, TTable As Range) As String
Dim StaR As Long, EndR As Long
'
For I = 1 To TTable.Rows.Count
    If Left(TTable.Cells(I, 1), 5) = "Task " And StaR <> 0 Then
        EndR = I
        Exit For
    End If
    If TTable.Cells(I, 1) = "Task " & TaskN Then
        StaR = I
    End If

Next I
If EndR = 0 Then EndR = I - 1
If StaR > 0 Then
    For I = StaR + 1 To EndR - 1
        If TTable.Cells(I, 1) <> "" Then
            GetTasks = GetTasks & TTable.Cells(I, 1) & ";"
        End If
    Next I
Else
    GetTasks = ";"
End If
End Function

Put the code into a standard module of your vba project then get the tasks in your variable by using

myVariable = GetTasks(Sheets("List").Range("A3"),Sheets("Tasks").Range("A1:A100"))

 

[OaklandJim]

I found the issue. My code was looking for the word Task as a condition for exiting the loop. BUT, for the last Task entry there is no occurrence of the word Task at the end of the range. So needed to add two conditions:

Do Until Left(sTaskAlpha, 4) = "Task" Or sTaskAlpha = ""

 

[smozgur]

Although necessary code snipped has not been provided, the issue has been already identified and solved in post #4.

Therefore I switched the marked solution post accordingly by also considering it will help future readers in a more generic way who would be using any kind of loop method.