Excel VBA：嵌套循环中的FindNext

Question

I am trying to create a loop using the .Find function within another loop which is already using .Find . I want to search for strings that I have saved in an array.

For example, these are the string values saved in the array strItem in Sheet1.

"unit1", "unit2", "unit3"

I would like to search them one by one from Sheet2. Sheet2 looks like this:

unit1
unit2
unit3
unit1.pdf
text1
subject1
subject2
subject3
text2
=========
unit2.pdf
text1
subject1
subject2
subject3
text2
=========
unit3.pdf
text1
subject1
subject2
subject3
text2
=========

After searching for "unit1.pdf" , I search all cells below it for "subject", and get cell values of subject1, 2, and 3. The search for "subject" cells should stop at the next cell which contains "====".

Next I search for "unit2" , and if found search for "subject" cells under it as before. Again, stop at the cell containing "====". And so on.

In my code, what I am trying to do was

• Search for the string "unit".
• Use its .row as the range to start searching for "subject".
• Return all subjects until the cell contains "====" . This is a part of my code that I can't really make to work .

Code:

Wb2.Sheets("Sheet2").Activate
With Wb2.Sheets("Sheet2").Range("A1:A1048575")
    For Each strItem In arrExcelValues
        myStr = strItem & ".pdf"
        Set p = .Find(What:=myStr, LookIn:=xlValues, _
                      LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False)
        If Not p Is Nothing Then
            firstAddress = p.Address
            Do
                myStr2 = p.row
                strStart = "A" & myStr2
                strEnd = "A1048575"

                With Wb2.Sheets("Sheet2").Range(strStart, strEnd)
                    Set p1 = .Find(What:="Subject", LookIn:=xlValues, _
                                   LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False)
                    If Not p1 Is Nothing Then
                        firstAddress = p1.Address
                        Do
                            myStr2 = myStr2 + 1
                            If p1.Offset(myStr2, 0).Value = "====" Then
                                Exit Do
                            Else
                                MsgBox p1.Value & strItem
                            End If
                            Set p1 = .FindNext(p1)
                        Loop While Not p1 Is Nothing And p1.Address <> firstAddress
                    Else
                        MsgBox "Not found"
                    End If
                End With
                    Set p = .FindNext(p)
            Loop While Not p Is Nothing And p.Address <> firstAddress
        Else
            MsgBox "Not found"
        End If
    Next
End With

Answer 1

You're not far off, but there are a couple of things to think about:

• It seems you know the order of your data, you can use this to make life easier than using Find on the entire column.

• You cannot use nested With statements unless you are going further into the child elements. It is good you are trying to fully qualify things, but be careful. For instance,

   ' This is okay With ThisWorkbook.Sheets("Sheet2") With .Range("A1") MsbBox .Value End With With .Range("A2") MsgBox .Value End With End With ' This is not okay, and present in your code With ThisWorkbook.Sheets("Sheet2").Range("A1") MsgBox .Value With ThisWorkbook.Sheets("Sheet2").Range("A2") Msgbox .Value End With End With 

I have taken the ideas in your code, and re-written it to be a bit clearer, and hopefully achieve what you want. See the comments for details:

Dim Wb2 As Workbook
Dim lastRow As Long
Set Wb2 = ThisWorkbook
' Get last used row in sheet, so search isn't on entire column
lastRow = Wb2.Sheets("Sheet2").UsedRange.Rows.Count
' Set up array of "unit" values
Dim arrExcelValues() As String
arrExcelValues = Split("unit1,unit2,unit3", ",")

' Declare variables
Dim pdfCell As Range
Dim eqCell As Range
Dim eqRow As Long
eqRow = 1
Dim subjCell As Range
Dim strItem As Variant

' Loop over unit array
With Wb2.Sheets("Sheet2")
For Each strItem In arrExcelValues
    ' Find the next "unitX.pdf" cell after the last equals row (equals row starts at 1)
    Set pdfCell = .Range("A" & eqRow, "A" & lastRow).Find(what:=strItem & ".pdf", lookat:=xlPart)
    If Not pdfCell Is Nothing Then
        ' pdf row found, find next equals row, store row value or use last row
        Set eqCell = .Range("A" & pdfCell.Row, "A" & lastRow).Find(what:="====", lookat:=xlPart)
        If eqCell Is Nothing Then
            eqRow = lastRow
        Else
            eqRow = eqCell.Row
        End If
        ' Loop through cells between pdf row and equals row
        For Each subjCell In .Range("A" & pdfCell.Row, "A" & eqRow)
            ' If cell contents contain the word "subject" then do something (display message)
            If InStr(UCase(subjCell.Value), "SUBJECT") > 0 Then
                MsgBox "Subject: " & subjCell.Value & ", Unit: " & strItem
            End If
        Next subjCell
    Else
        MsgBox "Item not found: " & strItem & ".pdf"
    End If
Next strItem
End With