How to end this loop?

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

"If Str = c.Value Then GoTo 85"

Change to

"If Str = c.Value Then End"

Answer 2

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.