Help with mistake when loop multiple folder but only one statement

[excel_newbie86]

I have this code to get data from miltiple folder then copy to master, folder name in masterworkbook, sheet("main").Range("A2:A" & i). But if the're only one Folder in list, for examble only in range("B2") => have false "Type miss match" in line:
For Each fDer In fFolder

Pleas help me to improve code, my full code belove:

Option Explicit

Sub Loop_Case_1dvi_mulfolder()
Dim myPath As String, mycn As String, fpath As String, wB As Workbook, ws As Worksheet, wsh As Long, aray() As Variant
Dim MyObj As Object, MySource As Object, file As Variant, v As Variant, fDer As Variant, fFolder As Variant
Dim cn As Object, rs1 As Object, fso As Object, rs2 As Object
Dim lRow As Long, lr1 As Long, lr2 As Long, lco As Long, i As Long, j As Long
Dim a, b, c, d, e, f, g As Integer
Dim strttme As Single: strttme = Timer

With ThisWorkbook
        On Error Resume Next
        .Sheets("list").Range("D2:AA500").ClearContents
        aray = Array("G00014", "G00854", "G03654", "C00204", "A00024")
        For wsh = LBound(aray) To UBound(aray)
            With Sheets(aray(wsh))
                .AutoFilterMode = False
                .Cells.Clear
                .Range("A1").Value = "File_Name"
                .Range("B1:D1").Value = "HEADER"
            End With
        Next wsh
        On Error GoTo 0
    With .Sheets("Main")
        mycn = .Range("B2")
        i = .Range("a" & Rows.Count).End(xlUp).Row
        fFolder = .Range("A2:A" & i).Value
    End With
    Set cn = CreateObject("adodb.connection")
    Set fso = CreateObject("Scripting.FileSystemObject")

Application.ScreenUpdating = False
For Each fDer In fFolder
    myPath = .Path & "\" & fDer
    If Right(myPath, 1) <> "\" Then myPath = myPath & "\"
    If Len(Dir(myPath, vbDirectory)) = 0 Then
        MsgBox ("Khong tim thay Folder: " & fDer)
        Exit Sub
    End If
    file = Dir(myPath & "*" & mycn & "*.xl*")

    While (file <> "")
    Select Case Left(file, 6)
    Case "G00014"
        Set wB = Workbooks.Open(myPath & file)
        lr1 = .Sheets("G00014").Range("B" & Rows.Count).End(3).Row + 1
            wB.Worksheets("G000141").Range("B19:L787").Copy .Sheets("G00014").Cells(lr1, 2)
            .Sheets("G00014").Range("A" & lr1).Resize(769).Value = file
        lr2 = .Sheets("G00014").Range("B" & Rows.Count).End(3).Row + 1
            wB.Worksheets("G000142").Range("B19:G111").Copy .Sheets("G00014").Cells(lr2, 2)
            .Sheets("G00014").Range("A" & lr2).Resize(93).Value = file
            v = Mid(file, 8, 8)
            With .Sheets("list")
                .Cells(.Range("B:B").Find(What:=v, LookIn:=xlValues).Row, "E").Value = "YES"
            End With
            wB.Close False
            a = a + 1
    Case "G00854"
        Set wB = Workbooks.Open(myPath & file)
        lr1 = .Sheets("G00854").Range("B" & Rows.Count).End(3).Row + 1
            wB.Worksheets("G008541").Range("A19:M52").Copy .Sheets("G00854").Cells(lr1, 2)
            .Sheets("G00854").Range("A" & lr1).Resize(34).Value = file
            v = Mid(file, 8, 8)
            With .Sheets("list")
                .Cells(.Range("B:B").Find(What:=v, LookIn:=xlValues).Row, "F").Value = "YES"
            End With
            wB.Close False
            b = b + 1
    Case "G03654"
        Set wB = Workbooks.Open(myPath & file)
        lr1 = .Sheets("G03654").Range("B" & Rows.Count).End(3).Row + 1
            wB.Worksheets("G036541").Range("A20:L55").Copy .Sheets("G03654").Cells(lr1, 2)
            .Sheets("G03654").Range("A" & lr1).Resize(36).Value = file
            v = Mid(file, 8, 8)
            With .Sheets("list")
                .Cells(.Range("B:B").Find(What:=v, LookIn:=xlValues).Row, "G").Value = "YES"
            End With
            wB.Close False
            c = c + 1
    Case "A00024"
        Set wB = Workbooks.Open(myPath & file)
        lr1 = .Sheets("A00024").Range("B" & Rows.Count).End(3).Row + 1
            wB.Worksheets("A000241").Range("A20:N93").Copy .Sheets("A00024").Cells(lr1, 2)
            .Sheets("A00024").Range("A" & lr1).Resize(74).Value = file
            v = Mid(file, 8, 8)
            With .Sheets("list")
                .Cells(.Range("B:B").Find(What:=v, LookIn:=xlValues).Row, "H").Value = "YES"
            End With
            wB.Close False
            d = d + 1
    Case "C00204"
        Set wB = Workbooks.Open(myPath & file)
        lr1 = .Sheets("C00204").Range("B" & Rows.Count).End(3).Row + 1
            wB.Worksheets("C002041").Range("A20:I53").Copy .Sheets("C00204").Cells(lr1, 2)
            .Sheets("C00204").Range("A" & lr1).Resize(34).Value = file
            v = Mid(file, 8, 8)
            With .Sheets("list")
                .Cells(.Range("B:B").Find(What:=v, LookIn:=xlValues).Row, "I").Value = "YES"
            End With
            wB.Close False
            e = e + 1
    Case Else
    End Select
    file = Dir
    Wend
    With Sheets("G00014").Columns("D:I")
        .NumberFormat = "0"
        .Value = .Value
    End With
    With Sheets("G00854").Range("E:N")
    .Replace ",", "."
    .NumberFormat = "#,##0.0"
    .Value = .Value
    End With
    With Sheets("G03654").Range("F:M")
        .Replace ",", "."
        .NumberFormat = "#,##0.0"
        .Value = .Value
    End With
    With Sheets("A00024").Range("E:O")
        .Replace ",", "."
        .NumberFormat = "#,##0.0"
        .Value = .Value
    End With
    With Sheets("C00204").Range("E:J")
        .Replace ",", "."
        .NumberFormat = "#,##0.0"
        .Value = .Value
    End With
    With Sheets("list")
        lco = .Cells(1, Columns.Count).End(xlToLeft).Column
        lr2 = .Range("B" & Rows.Count).End(3).Row
        For i = 2 To lr2
            .Cells(i, 4).Value = WorksheetFunction.CountIf(.Range(.Cells(i, "E"), .Cells(i, lco)), "YES")
        Next i
        For j = 5 To lco
            .Cells(2, j).Value = WorksheetFunction.CountIf(.Range(.Cells(3, j), .Cells(lr2, j)), "YES")
        Next j
    End With
Next
Application.ScreenUpdating = True
End With
MsgBox ("Summary total: " & a + b + c + d + e & " files, include: " & vbCrLf & vbCrLf & a & " files G00014" & vbCrLf & b & " files G00854" & vbCrLf & c & _
" files G03654" & vbCrLf & d & " files A00024" & vbCrLf & e & " files C00204" & vbCrLf & vbCrLf & "Total time: " & Format(Round(Timer - strttme, 3), "0.0") & " Seconds")
End Sub

 

[jmacleary]

I may be wrong, but if there is only 1 entry then you are setting fFolder to a single cell with the line:
fFolder = .Range("A2:A" & i).Value
As fFolder is defined as variant, this would set fFolder to the cell value, rather than an array of values. Then, the for each doesn't work against a single cell.

As I say, I may be wrong.

 

[excel_newbie86]

I may be wrong, but if there is only 1 entry then you are setting fFolder to a single cell with the line:
fFolder = .Range("A2:A" & i).Value
As fFolder is defined as variant, this would set fFolder to the cell value, rather than an array of values. Then, the for each doesn't work against a single cell.

As I say, I may be wrong.

You're right but I want have another to do this. Do you have any idea to help me?