How to end this loop? - vba

Question

I currently have a VBA Code written to ask for a users input of a string as well as a certain directory, and it searches through each folder, subfolder, workbook and worksheets until it finds the string the user put in. The issue I'm running into is that after it finds the string, it continues to search the rest of the folders. The application I'll be using this in, there is only one of that string being searched. I have tried debugging, and using an if statement with "c" to match str but it keeps throwing an error. The code is attached below, any help is appreciated.
Public WS As Worksheet
Sub SearchWKBooksSubFolders(Optional Folderpath As Variant, Optional Str As Variant)
Dim myfolder As String
Dim a As Single
Dim sht As Worksheet
Dim Lrow As Single
Dim Folders() As String
Dim Folder As Variant
ReDim Folders(0)
If IsMissing(Folderpath) Then
Set WS = Sheets.Add
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
myfolder = .SelectedItems(1) & "\"
End With
Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2)
If Str = "" Then Exit Sub
WS.Range("A1") = "Search string:"
WS.Range("B1") = Str
WS.Range("A2") = "Path:"
WS.Range("B2") = myfolder
WS.Range("A3") = "Folderpath"
WS.Range("B3") = "Workbook"
WS.Range("C3") = "Worksheet"
WS.Range("D3") = "Cell Address"
WS.Range("E3") = "Link"
Folderpath = myfolder
Value = Dir(myfolder, &H1F)
Else
If Right(Folderpath, 2) = "\\" Then
Exit Sub
End If
Value = Dir(Folderpath, &H1F)
End If
Do Until Value = ""
If Value = "." Or Value = ".." Then
Else
If GetAttr(Folderpath & Value) = 16 Then
Folders(UBound(Folders)) = Value
ReDim Preserve Folders(UBound(Folders) + 1)
ElseIf (Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm") And Left(Value, 1) <> "~" Then
On Error Resume Next
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=Folderpath & Value, Password:="zzzzzzzzzzzz")
On Error GoTo 0
'If there is an error on Workbooks.Open, then wb Is Nothing:
If wb Is Nothing Then
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
WS.Range("A" & Lrow).Value = Value
WS.Range("B" & Lrow).Value = "Password protected"
Else
For Each sht In wb.Worksheets
'Expand all groups in sheet
sht.Unprotect
sht.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8
Set c = sht.Cells.Find(Str, After:=sht.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
WS.Range("A" & Lrow).Value = Folderpath
WS.Range("B" & Lrow).Value = Value
WS.Range("C" & Lrow).Value = sht.Name
WS.Range("D" & Lrow).Value = c.Address
WS.Hyperlinks.Add Anchor:=WS.Range("E" & Lrow), Address:=Folderpath & Value, SubAddress:= _
"'" & sht.Name & "'" & "!" & c.Address, TextToDisplay:="Link"
Set c = sht.Cells.FindNext(After:=c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next sht
wb.Close False
End If
End If
End If
Value = Dir
Loop
For Each Folder In Folders
Call SearchWKBooksSubFolders(Folderpath & Folder & "\", Str)
Next Folder
Cells.EntireColumn.AutoFit
End Sub

Answer 1

Add a boolean variable that you set to True to indicate that you've found what you're looking for. Something like this:
Sub SearchWKBooksSubFolders(Optional Folderpath As Variant, Optional Str As Variant)
Dim myfolder As String
Dim a As Single
Dim sht As Worksheet
Dim Lrow As Single
Dim Folders() As String
Dim Folder As Variant
ReDim Folders(0)
If IsMissing(Folderpath) Then
Set WS = Sheets.Add
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
myfolder = .SelectedItems(1) & "\"
End With
Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2)
If Str = "" Then Exit Sub
WS.Range("A1") = "Search string:"
WS.Range("B1") = Str
WS.Range("A2") = "Path:"
WS.Range("B2") = myfolder
WS.Range("A3") = "Folderpath"
WS.Range("B3") = "Workbook"
WS.Range("C3") = "Worksheet"
WS.Range("D3") = "Cell Address"
WS.Range("E3") = "Link"
Folderpath = myfolder
value = Dir(myfolder, &H1F)
Else
If Right(Folderpath, 2) = "\\" Then
Exit Sub
End If
value = Dir(Folderpath, &H1F)
End If
'---Add this:
Dim TimeToStop As Boolean
'---Change this:
Do Until TimeToStop
If value = "." Or value = ".." Then
Else
If GetAttr(Folderpath & value) = 16 Then
Folders(UBound(Folders)) = value
ReDim Preserve Folders(UBound(Folders) + 1)
ElseIf (Right(value, 3) = "xls" Or Right(value, 4) = "xlsx" Or Right(value, 4) = "xlsm") And Left(value, 1) <> "~" Then
On Error Resume Next
Dim wb As Workbook
Set wb = Workbooks.Open(fileName:=Folderpath & value, Password:="zzzzzzzzzzzz")
On Error GoTo 0
'If there is an error on Workbooks.Open, then wb Is Nothing:
If wb Is Nothing Then
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
WS.Range("A" & Lrow).value = value
WS.Range("B" & Lrow).value = "Password protected"
Else
For Each sht In wb.Worksheets
'Expand all groups in sheet
sht.Unprotect
sht.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8
Set c = sht.Cells.Find(Str, After:=sht.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
'---Add this
TimeToStop = True 'since we found what we're looking for
firstAddress = c.Address
Do
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
WS.Range("A" & Lrow).value = Folderpath
WS.Range("B" & Lrow).value = value
WS.Range("C" & Lrow).value = sht.Name
WS.Range("D" & Lrow).value = c.Address
WS.Hyperlinks.Add Anchor:=WS.Range("E" & Lrow), Address:=Folderpath & value, SubAddress:= _
"'" & sht.Name & "'" & "!" & c.Address, TextToDisplay:="Link"
Set c = sht.Cells.FindNext(After:=c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next sht
wb.Close False
End If
End If
End If
value = Dir
'---Add these 3 lines
If Len(value) = 0 Then
TimeToStop = True
End If
Loop
For Each Folder In Folders
Call SearchWKBooksSubFolders(Folderpath & Folder & "\", Str)
Next Folder
Cells.EntireColumn.AutoFit
End Sub
Do note that you're calling your routine recursively:
For Each Folder In Folders
Call SearchWKBooksSubFolders(Folderpath & Folder & "\", Str)
Next Folder
Once you've gone through all your searching routine, you're going to start all over again because you're calling your Sub from within your Sub. Don't know if this is what you're after, and it may be an additional cause of further unexpected looping.

Answer 2

"If Str = c.Value Then GoTo 85"
Change to
"If Str = c.Value Then End"