EXCEL VBA do loop early exiting

by KWPH   Last Updated October 17, 2019 15:26 PM - source

With a lot of help, I recently finished a macro, which helps me find the correct files and then import and consolidate the data from these different source files into a master file.

So I have a list a product name in column A (Master file), with the product name in column A, I need to go to one main folder(C:\New Product), and then search the sub folder that contains the name of Product name. After, inside this Sub folder, there is a unique file I need to open and go there copy some information.

To wrap it up , it looks like this: eg: Product Name: AAB Mainfolder: C:\New Product Sub folder: C:\New Product\AAB-dfere (Sub folder always name with product name, “ - ", Brand NAME source file path: C:\New Product\AAB-dfere\Ass_Sheet_AAB (Master).xlsb (Starts with Ass_Sheet, contains product name)

So I used a nested an array to find and store the Sub folders, and another loop to find the source files, which match my "requirement" .

The problem I have right now is that, I see the array could store all the subfolders under the mainfolder, however, when the marco searched the matched folder/file, I found it skipped some of the subfolder/files. And since it can't find the matched subfolder/file, it exit the loop and stop.

eg, product name BBC, Sub folder BBC - dfd is there, source file C:\New Product\BBC - dfd\Ass_Sheet_BBC (Master).xlsb is there. But the macro just can't find it.

During the debug process,The macro would number each subfolder(dim idx) as sequence. But when the do loop proceed the process, it did not search idx by sequence, such as 1,2, 3, 4,5.... but 1, 2, 5, 7, 10

Is anyone know how to correct this? Your help would really save my life. Thank you.

Here are my do loop:

Sub prc_Store_SubFolders()
    Dim lastRow As Integer
    lastRow = ThisWorkbook.Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row
    Dim i As Integer
    For i = 2 To lastRow

        Dim SubFolder As String
        SubFolder = Dir(MainFolder & "\*.*", vbDirectory) 
        Dim arrayCnt As Integer: arrayCnt = 0 
        Do While SubFolder <> ""
            If (Len(SubFolder) > 2) Then
                ReDim Preserve Ary_SubFolders(arrayCnt) 
                          Array_SubFolders(arrayCnt) = MainFolder & "\" & SubFolder

                aryCnt = aryCnt + 1
            End If
            SubFolder = Dir()   
End Sub

    Dim idx As Integer
    For idx = 0 To UBound(Array_SubFolders)
        Dim fileName As String
        fileName = Dir(Array_SubFolders(idx) & "/*.xlsb")
        On Error Resume Next
        Do While fileName <> ""
            FullPathFileName = Array_SubFolders(idx) & "\" & fileName
            If (Left(fileName, 12) = "Ass_Sheet_") Then
                Dim prodName As String
                prodName = ThisWorkbook.Sheets("Master").Cells(MasterRow, 1).Value
                If (InStr(fileName, prodName) > 0) Then
                    Call prc_Import_Values(fileName)
                    MasterRow = MasterRow + 1
                End If
            End If
            fileName = Dir()
        With ThisWorkbook.Sheets("Master")
            If (.Cells(MasterRow, 20).Value = "") Then
                .Cells(MasterRow, 20).Value = "**File Not Found**"
            End If
        End With


    MsgBox "--- done ---"
End Sub

Related Questions

Query AD need nested group info

Updated April 30, 2017 23:26 PM

store parent, child, grand- child data in memory

Updated August 04, 2016 08:12 AM