简体   繁体   中英

VBA Recursive loop for columns

Can anyone explain me if I can recursively loop through a sorted list inside a For loop?

I am looping through a column, and once I found an exact match (lets say EALOLES string), then I want to keep on looping until there's no more matches. Data example

For i = 2 to UsedRange.Rows.Count
  If (Cells(i, 12).Value = "EALOLES") Then
    ' Start an inner loop until EALOLES ends, increment i++
    ' Perform actions appropriate to EALOLES case
    Exit For
  End If
next i

This is all fine with an inner loop, but I was just wondering if this could be achieved also with a recursive function and how that would look like? From the example I learned about recursion, I would imagine to loop from end of workbook to the beginning.

Note, I am not stating it would be a better solution, neither an inner loop, but I am just very curious.

Your question is basically is this a candidate for recursion, and the answer is no. Iteration with your inner loop is the better solution in this case.

Read the article: Recursion and Iteration to learn when to use each.

Assuming your data are sorted, you could take advantage of that

Dim nOccurrences As Long
Dim cell As Range
With Intersect(ActiveSheet.UsedRange, Columns(12))
    nOccurrences = WorksheetFunction.CountIf(.Cells, "EALOLES")
    If nOccurrences > 0 Then
        For Each cell in .Resize(nOccurrences).Offset(.Find(What:= "EALOLES", LookIn:=xlValues, LookAt:=xlWhole, After:=.Cells(.Rows.Count)).Row-1)
              ‘Do your things
        Next
    End If
End With

This is not an efficient method of returning the start and stop positions of a string in a sorted list but as an intellectual excercise this should do.

dim i as long, j as long

For i = 2 to UsedRange.Rows.Count
  If (Cells(i, 12).Value = "EALOLES") Then
    for j=i to UsedRange.Rows.Count
      If (Cells(j+1, 12).Value <> "EALOLES") Then
        exit for
      end if
    next j
    Exit For
  End If
next i

debug.print "start: " & i
debug.print "end: " & j

I was musing with a slightly different take on the same theme

Define a range to loop over. See if the value exists in the range. If it does, start at the first match and keep looping the loop range until the cell value differs from the specified target string.

Option Explicit

Sub StopAtEnd()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim endRow As Long

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet5")             'change as needed

    endRow = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row

    Dim loopRange As Range

    Set loopRange = ws.Range("L1:L" & endRow) 'Change start row as required

    Dim currentCell As Range
    Dim targetString As String
    Dim startRow As Long

    targetString = "EALOLES"

    On Error GoTo Errhand

    startRow = Application.Match(targetString, loopRange, 0)

    Do Until ws.Range("L" & startRow) <> targetString
        Debug.Print ws.Range("L" & startRow).Address
        startRow = startRow + 1
    Loop

    Exit Sub

Errhand:

    MsgBox "Target string not found"

End Sub

Shout out to @DisplayName who pointed out this could be written instead as:

Option Explicit

Sub StopAtEnd()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim endRow As Long

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")             'change as needed

    endRow = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row

    Dim loopRange As Range

    Set loopRange = ws.Range("L1:L" & endRow) 'Change start row as required

    Dim currentCell As Range
    Dim targetString As String
    Dim startRow As Variant

    targetString = "EALOLES"

    startRow = Application.Match(targetString, loopRange, 0)

    If IsError(startRow) Then

        MsgBox "Target string not found"

    Else

        Do Until ws.Range("L" & startRow) <> targetString

            Debug.Print ws.Range("L" & startRow).Address
            startRow = startRow + 1

        Loop

   End If

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM