Run-time Error 5 - Invalid procedure call or argument.

[Christoffer]

I have a problem when trying to merge my new code into the old sheet. Excel keeps complaining about Run-time error '5'.

Dim FSO As Object
Dim myFolder As Folder
Dim mySubFolder As Folder
Dim bCell As Range
Dim cCell As Range
Dim FileName As String
Dim FilePath As String
Dim Folder As Variant
Dim Title As String
Dim A As Long
Dim B As Long
Dim C As Long
Dim R As Long

Sub CopyFromWorkbooks()

    'Sheets("Sheet2").Select
    Set DstWks = Sheets("Sheet1")
    Set DstRng = DstWks.Range("A1")
    
    Set RngEnd = DstWks.Cells(Rows.Count, DstRng.Column).End(xlUp)
    Set DstRng = IIf(RngEnd = "", DstRng, RngEnd.Offset(1, 0))
  
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = FSO.GetFolder("\\tango\01006\Quality Hours")

For Each mySubFolder In myFolder.SubFolders
    DstRng.Offset(A, 0) = mySubFolder.Path
    A = A + 1
Next
   
For Each bCell In DstWks.UsedRange.Columns("A").Cells
    Set myFolder = FSO.GetFolder(bCell)
    For Each mySubFolder In myFolder.SubFolders
        DstRng.Offset(B, 1) = mySubFolder.Path
        B = B + 1
    Next mySubFolder
Next bCell

Range("Q6") = 1

For Each cCell In DstWks.UsedRange.Columns("B").Cells
     
    Set DstWks = Sheets("Sheet2")
    Set DstRng = DstWks.Range("A3")
    
    FilePath = cCell
    FileName = Dir(cCell & "\*.xlsm")
    
    If FileName = "" Then
         MsgBox "No Excel workbooks were found in this directory.", vbCritical
         Exit Sub
      End If
      
      Application.ScreenUpdating = False
      
        Do While FileName <> ""
          On Error GoTo ErrorExit
          Set SrcWkb = Workbooks.Open(FileName:=FilePath & "\" & FileName, ReadOnly:=True)
            For Each SrcWks In SrcWkb.Worksheets
            Select Case SrcWks.Name
            Case "Sheet1"
              DstRng.Offset(R, 0) = SrcWks.Range("D4")
              DstRng.Offset(R, 1) = SrcWks.Range("F4")
              DstRng.Offset(R, 2) = SrcWks.Range("I8")
              DstRng.Offset(R, 3) = SrcWks.Range("G6")
              DstRng.Offset(R, 4) = SrcWks.Range("A6")
              DstRng.Offset(R, 5) = SrcWks.Range("G4")
            Case "Sheet2"
              DstRng.Offset(R, 6) = SrcWks.Range("A2")
              DstRng.Offset(R, 7) = SrcWks.Range("B2")
              DstRng.Offset(R, 8) = SrcWks.Range("C2")
              DstRng.Offset(R, 9) = SrcWks.Range("D2")
              DstRng.Offset(R, 10) = SrcWks.Range("E2")
              DstRng.Offset(R, 11) = SrcWks.Range("F3")
            End Select
              
            Next SrcWks
          SrcWkb.Close False
          FileName = Dir()
          R = R + 1
        Loop
        
ErrorExit:
      Application.ScreenUpdating = True
      If Err <> 0 Then
         MsgBox "Run-time error '" & Err.Number & "':" & vbCrLf & Err.Description
      End If
    
Next cCell
End Sub

And when I use this code in a clean sheet, everything runs smoothly. But once I put it into my old sheet the runtime error pops up.
According to debug it happens here:

For Each bCell In DstWks.UsedRange.Columns("A").Cells
    Set myFolder = FSO.GetFolder(bCell)
    For Each mySubFolder In myFolder.SubFolders
        DstRng.Offset(B, 1) = mySubFolder.Path
        B = B + 1
    Next mySubFolder
Next bCell

The error pops out when the loop is done checking the last folder.

I have a backup version of the old sheet that I'm experimenting with, and the odd thing is that when I run the new code on the backup sheet for the first time, it runs through it. Every attempt to run it again is aborted by the run-time error.
I can't for the life of me figure out what's causing this.

 

[Christoffer]

Update:

After looking closer at the debugging I have found out this:
In the clean sheet, when the code is at the last entry in column A, instead of trying to run the loop again it continues on with the code. This is the correct way.
In the old sheet, when the code is at the last entry in column A, it tries to run the loop again, even though there are no more entries in said column. This casus the error and stops the code.

I still have no idea on how to avoid this though.
Also, the old sheet was originally made by someone else so I guess he could have made some changes that could provoke this error.

 

[Christoffer]

Solved the problem by adding a simple IF condition in the loop.

Solution:

For Each bCell In DstWks.UsedRange.Columns("A").Cells    If bCell = "" Then
        Exit For
    End If
    Set myFolder = FSO.GetFolder(bCell)
    For Each mySubFolder In myFolder.SubFolders
        DstRng.Offset(B, 1) = mySubFolder.Path
        B = B + 1
    Next mySubFolder
Next bCell